diff --git a/.gitignore b/.gitignore index da1f14c2a..2233adc6b 100644 --- a/.gitignore +++ b/.gitignore @@ -2,7 +2,6 @@ * # Now, whitelist anything that's a directory !*/ -!*/python # whitelist only the files that ever need to be tracked !*.f90 !*.sh @@ -10,49 +9,18 @@ !*.cmake !CHANGELOG !README.md +!README_figs/** +!README_tables/** !paper/paper.md !paper/paper.bib !README.swifter -!*.in dump* -!example/cleanup -!example/swifter_symba_omp -!Makefile -src/*/Makefile -!Makefile.Defines -src/*/Makefile.Defines -!.gitignore +!**/.gitignore !*.py !*.ipynb +!examples/** *ipynb_checkpoints - -#fxdr library -!fxdr*/*.c -!fxdr*/*.F -!fxdr*/*.3f -!fxdr*/*.h -!fxdr*/*.inc -!fxdr*/cxdrreal64 -!fxdr*/test.orig.xdr -!fxdr*/test_read_only.xdr -!fxdr*/configure/ -!fxdr*/README* -!fxdr*/Makefile.bak -!fxdr*/Makefile.fxdr -!fxdr*/Makefile.tmpl -!fxdr*/Defines.* - -#collresolve -!collresolve/*.c -!collresolve/*.h -!collresolve/*.py -!collresolve/Makefile.am -!collresolve/configure.ac -!collresolve/cambioni2019/*.h -!collresolve/cambioni2019/*.c -collresolve/config.h - - +**/.DS_Store #Documentation !docs/* @@ -60,25 +28,5 @@ collresolve/config.h !docs/*/*/* !README_figs/* -python/swiftest/tests/convert_code_type/swift2swifter/pl.swift2swifter.in - -python/swiftest/tests/convert_code_type/swift2swifter/tp.swift2swifter.in - -python/swiftest/tests/convert_code_type/swift2swiftest/cb.swift2swiftest.in - -python/swiftest/tests/convert_code_type/swift2swiftest/pl.swift2swiftest.in - -python/swiftest/tests/convert_code_type/swift2swiftest/tp.swift2swiftest.in - -python/swiftest/tests/convert_code_type/swifter2swiftest/cb.swifter2swiftest.in - -python/swiftest/tests/convert_code_type/cb.swifter2swiftest.in - -python/swiftest/tests/convert_code_type/swifter2swiftest/pl.swifter2swiftest.in - -python/swiftest/tests/convert_code_type/swifter2swiftest/tp.swifter2swiftest.in - -!python/swiftest/requirements.txt - bin/ build/* diff --git a/CMakeLists.txt b/CMakeLists.txt index 34b05b21e..5d4c8637f 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -7,7 +7,7 @@ # You should have received a copy of the GNU General Public License along with Swiftest. # If not, see: https://www.gnu.org/licenses. -# CMake project file for FOO +# CMake project file for SWIFTEST ################################################## # Define the project and the depencies that it has @@ -29,19 +29,21 @@ ENDIF(NOT CMAKE_Fortran_COMPILER_SUPPORTS_F90) # Set some options the user may choose # Uncomment the below if you want the user to choose a parallelization library -OPTION(USE_MPI "Use the MPI library for parallelization" OFF) -OPTION(USE_OPENMP "Use OpenMP for parallelization" OFF) +OPTION(USE_MPI "Use the MPI library for parallelization" ON) +OPTION(USE_OPENMP "Use OpenMP for parallelization" ON) + -# This INCLUDE statement executes code that sets the compile flags for DEBUG, -# RELEASE, and TESTING. You should review this file and make sure the flags -# are to your liking. -INCLUDE(${CMAKE_MODULE_PATH}/SetFortranFlags.cmake) # Locate and set parallelization libraries. There are some CMake peculiarities # taken care of here, such as the fact that the FindOpenMP routine doesn't know # about Fortran. INCLUDE(${CMAKE_MODULE_PATH}/SetParallelizationLibrary.cmake) - INCLUDE(${CMAKE_MODULE_PATH}/SetUpNetCDF.cmake) +INCLUDE(${CMAKE_MODULE_PATH}/SetMKL.cmake) + +# This INCLUDE statement executes code that sets the compile flags for DEBUG, +# RELEASE, PROFILING, and TESTING. +INCLUDE(${CMAKE_MODULE_PATH}/SetFortranFlags.cmake) + # There is an error in CMAKE with this flag for pgf90. Unset it GET_FILENAME_COMPONENT(FCNAME ${CMAKE_Fortran_COMPILER} NAME) @@ -54,17 +56,18 @@ ENDIF(FCNAME STREQUAL "pgf90") ############################################################ # Define the executable name -SET(FOOEXE swiftest_driver) +SET(SWIFTEST_DRIVER swiftest_driver) # Define some directories SET(SRC ${CMAKE_SOURCE_DIR}/src) SET(LIB ${CMAKE_SOURCE_DIR}/lib) SET(BIN ${CMAKE_SOURCE_DIR}/bin) +SET(MOD ${CMAKE_SOURCE_DIR}/include) # Have the .mod files placed in the lib folder -SET(CMAKE_Fortran_MODULE_DIRECTORY ${LIB}) +SET(CMAKE_Fortran_MODULE_DIRECTORY ${MOD}) -# The source for the FOO binary and have it placed in the bin folder +# The source for the SWIFTEST binary and have it placed in the bin folder ADD_SUBDIRECTORY(${SRC} ${BIN}) # Add a distclean target to the Makefile diff --git a/README.md b/README.md index 74c1a652c..6e6b17a0b 100644 --- a/README.md +++ b/README.md @@ -19,25 +19,24 @@ Swiftest also includes the collisional fragmentation algorithm **Fraggle**, an a **System Requirements** -Swiftest is designed to be downloaded, compiled, and run on a Linux based system. It is untested on Windows systems, however it should be possible to successfully install Swiftest on a Windows machine with only a few minor tweaks. +Swiftest is designed to be downloaded, compiled, and run on a Linux based system. It is untested on Windows systems. It is possible to download, compile, and run Swiftest on a machine with at least 400 MB of free disk space and 8 GB of RAM. To take full advantage of the parallelization and performance updates included in Swiftest, it is highly recommended that Swiftest be installed on a high-performance computing cluster. For reference, Swiftest is maintained on the Purdue University [Bell Community Cluster](https://www.rcac.purdue.edu/compute/bell). -Swiftest is written in Modern Fortran and must be compiled using an appropriate compiler. We recommend the Intel Fortran Compiler Classic (ifort) version 19.0 or higher. For details on installing ifort and the required Intel Math Kernel Library (intel-mkl), see the [Intel installation documentation](https://www.intel.com/content/www/us/en/developer/tools/oneapi/fortran-compiler.html#gs.6xhjgy). The GCC/GNU Fortran Compiler (gfortran) version 9 or higher is also compatible. For details on installing gfortran, see the [GNU Fortran documentation](https://gcc.gnu.org/wiki/GFortran). +Swiftest is written in Modern Fortran and must be compiled using an appropriate compiler. We recommend the Intel Fortran Compiler Classic (ifort) version 19.0 or higher. For details on installing ifort, see the [Intel installation documentation](https://www.intel.com/content/www/us/en/developer/tools/oneapi/fortran-compiler.html#gs.6xhjgy). The GCC/GNU Fortran Compiler (gfortran) version 9 or higher is also compatible. For details on installing gfortran, see the [GNU Fortran documentation](https://gcc.gnu.org/wiki/GFortran). -Swiftest output files are stored in the NetCDF file format. This takes the place of the flat binary output file included in Swifter (and its predecessor [Swift](https://www.boulder.swri.edu/~hal/swift.html)). The NetCDF output format is compatible with Python, Java, and other languages that can be used to process and analyze data. Details on installing NetCDF and the NetCDF Fortran Library can be found on the [Unidata website](https://docs.unidata.ucar.edu/netcdf-fortran/current/). NetCDF is built on HDF5 and it is necessary to install HDF and HDF5 as well. Details on installing HDF and HDF5 can be found on the [HDF Group website](https://www.hdfgroup.org/solutions/hdf5). +Swiftest output files are stored in the NetCDF file format. This takes the place of the flat binary output file included in Swifter (and its predecessor [Swift](https://www.boulder.swri.edu/~hal/swift.html)). The NetCDF output format is compatible with Python, Java, and other languages that can be used to process and analyze simulation data. Details on installing NetCDF and the NetCDF Fortran Library can be found on the [Unidata website](https://docs.unidata.ucar.edu/netcdf-fortran/current/). NetCDF is built on HDF5 and it is necessary to install HDF and HDF5 as well. Details on installing HDF and HDF5 can be found on the [HDF Group website](https://www.hdfgroup.org/solutions/hdf5). Parallelization in Swiftest is done with OpenMP. Version 3.1.4 or higher is necessary to make use of parallelization in Swiftest. If Swiftest is only to be run in serial, this package is not necessary. See the [OpenMP website](https://www.openmp.org/resources/openmp-compilers-tools/) for more details and installation instructions. *Example of a module configuration that is necessary for compiling and running Swiftest:* ``` 1. intel/19.0.5.281 -2. intel-mkl/2019.5.281 -3. openmpi/3.1.4 -4. netcdf/4.7.4 -5. netcdf-fortran/4.5.3 -6. hdf/4.2.15 -7. hdf5/1.10.6 +2. openmpi/3.1.4 +3. netcdf/4.7.4 +4. netcdf-fortran/4.5.3 +5. hdf/4.2.15 +6. hdf5/1.10.6 ``` **Downloading Swiftest** @@ -80,22 +79,19 @@ As mentioned in the **System Requirements** section, Swiftest requires the NetCD 1. Create an environment variable called ```NETCDF_FORTRAN_HOME``` that contains the path to the location where the libraries are installed 2. Set the path at the time of compilation using ```-CMAKE_PREFIX_PATH=/path/to/netcdf/``` -CMake allows the user to specify a set of compiler flags to use during compilation. We define three sets of compiler flags: release, testing, and debug. To view and/or edit the flags included in each set, see ```swiftest/cmake/Modules/SetFortranFlags.cmake```. +CMake allows the user to specify a set of compiler flags to use during compilation. We define five sets of compiler flags: release, testing, profile, math, and debug. To view and/or edit the flags included in each set, see ```swiftest/cmake/Modules/SetFortranFlags.cmake```. -As a general rule, the release flags are fully optimized and best used when running Swiftest with the goal of generating results. This is the default set of flags. When making changes to the Swiftest source code, it is best to compile Swiftest using the debug set of flags. To create your own set of compiler flags, edit the testing flags. +As a general rule, the release flags are fully optimized and best used when running Swiftest with the goal of generating results. This is the default set of flags. When making changes to the Swiftest source code, it is best to compile Swiftest using the debug set of flags. You may also define your own set of compiler flags. To build Swiftest with the release flags (default), type the following: ``` $ cmake .. ``` -To buid with the debug flags, type: +To build with the debug flags, type: ``` $ cmake .. -DCMAKE_BUILD_TYPE=DEBUG ``` -Finally, to build with the testing flags, type: -``` -$ cmake .. -DCMAKE_BUILD_TYPE=TESTING -``` +To build with another set of flags, simply replace ```DEBUG``` in the above line with the name of the flags you wish to use. Add ```-CMAKE_PREFIX_PATH=/path/to/netcdf/``` to these commands as needed. @@ -107,90 +103,107 @@ $ make The Swiftest executable, called ```swiftest_driver```, should now be created in the ```/swiftest/bin/``` directory. +**Swiftest Python Package** + +Included with Swiftest, in the ```/swiftest/python/swiftest/``` directory, is a Python package designed to fascilitate seamless data processing and analysis. The Python package, also called Swiftest, can be used to generate input files, run Swiftest simulations, and process output files in the NetCDF file format. + +To begin, Swiftest can be added to an existing conda environment, or a new conda environment may be created, so long as the required pacakges are installed. To create and activate a new conda environment with the prerequisite packages, open a terminal and navigate to the ```/swiftest/python/swiftest/``` directory. Type the following: + +``` +$ conda create --name EnvName pip scipy numpy matplotlib pandas xarray jupyter astropy -y +$ conda activate EnvName +``` + +Next, we will install further required pacakges. Using the ```-e``` flag imports all packages in ```/swiftest/python/swiftest/requirements.txt```, including Swiftest. If the Swiftest Python package is updated in the future, using the ```-e``` flag should ensure that the user does not have to reinstall the pacakge to use the updated verison. + +``` +$ pip install pySLALIB +$ pip install -e . +``` + +The Swiftest Python package should now be installed in the conda environment and is ready to use. If you would like to take the further step to add Swiftest to a Jupyter Notebook kernel, type the following: + +``` +$ ipython kernel install --user --name EnvName --display-name "Swiftest Kernel" +``` + --- #### Usage -When creating a new Swiftest simulation, ensure that all required input files exist in a unique directory. A symbolic link to the Swiftest driver should also exist in the simulation directory. To create a symbolic link to the Swiftest driver from your current directory, type: +Swiftest is built to make running a Swiftest simulation a streamlined and user friendly experience, even for a new user. As a result, Swiftest is highly flexible and a simulation can be created, run, and processed in a number of different ways. The first choice the user must make is if they would prefer ASCII input files or NetCDF input files. We recommend NetCDF input files, however we include documentation for ASCII input files for completeness. + +**Brief Outline** +To create and run a Swiftest simulation using the Swiftest Python package, follow the general script below. For more details on the input files and user options, continue reading this section. ``` -$ ln -s ~/PATH/TO/swiftest/bin/swiftest_driver . +import swiftest # Import the Swiftest Python package +sim = swiftest.Simulation(simdir = "directory_name", **kwargs) # Initialize a Swiftest simulation +sim.add_solar_system_body(**kwargs) # Add any desired named Solar System bodies +sim.add_body(**kwargs) # Add any desired user defined bodies +sim.get_parameter(**kwargs) # View the default simulation parameters +sim.set_parameter(**kwargs) # Set any desired simulation parameters +sim.write_param(**kwargs) # Write simulation parameters to the param.in +sim.run(**kwargs) # Run the simulation (ignore if running from the terminal) ``` -To run Swiftest, simply type the following command into the terminal: +To read in a set of Swiftest output files using the Swiftest Python package, follow the general script below. For more details on the output files and user options, continue reading this section. ``` -$ ./swiftest_driver INTEGRATOR param.in +import swiftest # Import the Swiftest Python package +sim = swiftest.Simulation(simdir = "directory_name", read_old_output=True) # Initialize a Swiftest simulation +sim.data # Body data over time +sim.init_cond # The initial conditions for the simulation +sim.encounters # Encounter data for all close encountering pairs +sim.collisions # Collision data for all colliders and collisional fragments ``` -Where ```INTEGRATOR``` is your integrator of choice, either ```whm```, ```rmvs```, ```helio```, or ```symba```. -**Inputs** +**NetCDF Input Files (Recommended)** + +Swiftest accepts a single NetCDF input file. This file can be created using the Swiftest Python Package through a few simple steps. + +To begin, simply create a new Python script in the directory you would like to store your simulation. Open the new script and import the Swiftest Python package. -Swiftest takes four input files. All four input files are necessary, however the structure of each input file varies slightly depending on the features and capabilities of the integrator selected. For examples of Swiftest input files, see the examples section. The four input files are as follows: +``` +import swiftest +``` + +Next, we initialize the Swiftest simulation object. Various parameters can be provided to the simulation via key word arguments at this stage. + +``` +sim = swiftest.Simulation(simdir = "directory_name", **kwargs) +``` + +The argument ```simdir``` is the name of the subdirectory in which to store all simulation data. This does not have to exist at the time the simulation object is initialized. + +The key word arguments available to the user, along with the default values for these arguments, are described in [simulation_kwargs](README_tables/simulation_kwargs.md). + +After creating the simulation and defining all desired parameters as keyword arguments, it is time to add bodies to the simulation. The Swiftest Python package interfaces with the [NASA JPL Horizons database](https://ssd.jpl.nasa.gov/horizons/), allowing a user to easily import the initial conditions of known solar system bodies using the ```add_solar_system_body``` method. + +``` +sim.add_solar_system_body(["Sun","Mercury","Venus","Earth","Mars","Jupiter","Saturn","Uranus","Neptune","Pluto"]) +``` + +User defined bodies can also be added to a Swiftest simulation through the Python package. Massive bodies and test particles can both be added using the ```add_body``` method. + +``` +sim.add_body(**kwargs) +``` + +The key word arguments available to the user for the ```add_body``` method are described in [add_body_kwargs](README_tables/add_body_kwargs.md). + +All desired bodies and parameters are added to the simulation object and the information is saved to a NetCDF input file (**init_cond.nc**) and an ASCII parameter file (**param.in**) automatically. The parameter file is not necessary to run a Swiftest simulation, it is simply a convenient reference for the user. These files are stored in the ```/simdata``` subdirectory. + +**ASCII Input Files** +Swiftest accepts 4 ASCII input files. All four input files are necessary, however the structure of each input file varies slightly depending on the features and capabilities of the integrator selected. For examples of Swiftest input files, see the examples section. The four input files are as follows: - **param.in** - The parameter input file. - **cb.in** - The central body input file. - **pl.in** - The massive body input file. - **tp.in** - The test particle input file. -The **param.in** includes all user parameters available for the integrator selected. The parameter options are as follows: - -| Parameter Name | Parameter Description | Input Format | Compatible Integrators | -|-------------------------|---------------------------------------|--------------------------------------------------------------------------------------|------------------------| -| ```T0``` | Simulation start time in time units | floating point (ex. ```0.0```) | all -| ```TSTOP``` | Simulation end time in time units | floating point (ex. ```100.0```) | all -| ```DT``` | Simulation timestep in time units | floating point (ex. ```0.005```) | all -| ```ISTEP_OUT``` | Output cadence in number of timesteps | integer (ex. ```200```) | all -| ```ISTEP_DUMP``` | Dump cadence in number of timesteps | integer (ex. ```200```) | all -| ```OUT_FORM``` | Output format | ```XV```, ```EL```, ```XVEL``` | all -| ```OUT_TYPE``` | Output file format | ```NETCDF_FLOAT```, ```NETCDF_DOUBLE``` | all -| ```OUT_STAT``` | Output status | ```NEW```, ```APPEND```, ```REPLACE```, ```UNKNOWN``` | all -| ```IN_FORM``` | Input format | ```EL```, ```XV``` | all -| ```IN_TYPE``` | Input file format | ```ASCII``` (```NETCDF_FLOAT```, and ```NETCDF_DOUBLE``` *under development*) | all -| ```NC_IN``` | NetCDF input file name | string (ex. ```nc.in```) | only if ```IN_TYPE``` is set to a NetCDF type, *under development* -| ```PL_IN``` | Massive body input file name | string (ex. ```pl.in```) | all -| ```TP_IN``` | Test particle input file name | string (ex. ```tp.in```) | all -| ```CB_IN ``` | Central body input file name | string (ex. ```cb.in```) | all -| ```BIN_OUT``` | Output file name | string (ex. ```out.nc```, ```bin.dat```) | all -| ```CHK_QMIN``` | Pericenter distance at which a test particle is too close to the pericenter of the system in distance units | floating point, turn off using ```-1.0``` | all -| ```CHK_RMIN``` | Heliocentric distance at which a test particle is considered merged with the central body in distance units | floating point, turn off using ```-1.0``` | all -| ```CHK_RMAX``` | Heliocentric distance at which a test particle is too distant from the central body in distance units | floating point (ex. ```1000.0```) | all -| ```CHK_EJECT``` | Heliocentric distance at which an unbound test particle is too distant from the central body in distance units | floating point (ex. ```1000.0```) | all -| ```CHK_QMIN_COORD``` | Coordinate frame used to check for pericenter distance | ```HELIO```, ```BARY``` | all -| ```CHK_QMIN_RANGE``` | Upper and lower bounds of the semimajor axis range used to check the pericenter distance | two floating points, turn off using ```-1.0 -1.0``` | all -| ```MU2KG``` | Mass units to kilogram conversion | floating point (ex. ```1.988409870698051e+30```) | all -| ```TU2S``` | Time units to seconds conversion | floating point (ex. ```31557600.0```) | all -| ```DU2M``` | Distance units to meters conversion | floating point (ex. ```149597870700.0```) | all -| ```EXTRA_FORCE``` | Additional user defined force routines provided | ```YES```, ```NO``` | all -| ```PARTICLE_OUT``` | Particle output file name | string (ex. ```particle.out```) | all -| ```BIG_DISCARD``` | Include data for all fully-interacting bodies (above GMTINY) in each discard | ```YES```, ```NO``` | all -| ```CHK_CLOSE``` | Check for close encounters | ```YES```, ```NO``` | all -| ```GR``` | General relativity | ```YES```, ```NO``` | all -| ```INTERACTION_LOOPS``` | Method for checking for interactions between bodies | ```TRIANGULAR```, ```FLAT```, ```ADAPTIVE``` | all -| ```ENCOUNTER_CHECK``` | Method for checking for close encounters between bodies | ```TRIANGULAR```, ```SORTSWEEP```, ```ADAPTIVE``` | all -| ```RHILL_PRESENT``` | Hill Radius present in massive body input file | ```YES```, ```NO``` | SyMBA -| ```FRAGMENTATION``` | Resolve collisions with fragmentation | ```YES```, ```NO``` | SyMBA -| ```ROTATION``` | Rotational vectors present in massive body input file | ```YES```, ```NO``` | SyMBA -| ```ENERGY``` | Track the total energy of the system | ```YES```, ```NO``` | SyMBA -| ```ENERGY_OUT ``` | Energy output file name | string (ex. ```energy.out```) | SyMBA -| ```ENC_OUT ``` | Encounter output file name | string (ex. ```enc.out```) | all -| ```GMTINY``` | Mass cutoff between fully and semi-interacting massive bodies in gravitational mass units | floating point (ex. ```4e-06```) | SyMBA -| ```MIN_GMFRAG``` | Minimum fragment mass in gravitational mass units | floating point (ex. ```1e-09```) | SyMBA -| ```TIDES``` | Tidal dissipation model | ```YES```, ```NO``` | *(under development)* -| ```YORP``` | YORP effect | ```YES```, ```NO``` | *(under development)* -| ```YARKOVSKY``` | Yarkovsky effect | ```YES```, ```NO``` | *(under development)* - -In the above **param.in**, the following are defined as: -- ```HELIO``` - Use the heliocentric coordinate frame for ```CHK_QMIN``` -- ```BARY``` - Use the barycentric coordinate frame for ```CHK_QMIN``` -- ```XV``` - Heliocentric position and velocity components for ```IN_FORM``` and/or ```OUT_FORM``` -- ```EL``` - Osculating orbital elements for ```IN_FORM``` and/or ```OUT_FORM``` -- ```XVEL``` - Heliocentric position and velocity components and osculating orbital elements for ```OUT_FORM``` -- ```NETCDF_FLOAT``` - Single precision NetCDF format for ```OUT_TYPE``` -- ```NETCDF_DOUBLE``` - Double precision NetCDF format for ```OUT_TYPE``` - -For more details on the ```INTERACTION_LOOPS``` and ```ENCOUNTER_CHECK``` options, see the **Updates to Swifter SyMBA** section below. +The parameter options used in the parameter input file are as described in [param_options](README_tables/param_options.md). The **cb.in** includes all central body initial conditions. The structure of the **cb.in** is as follows: @@ -236,17 +249,64 @@ The **tp.in** includes all test particle initial conditions. In the Note that the ID numbers of the test particles are a continuation of the ID numbers of the massive bodies. No two bodies in the system can have the same ID number. +**Running a Swiftest Simulation** + +The input files necessary to successfully run Swiftest should now be generated in the simulation directory. The user is now faced with a second choice: to run a Swiftest simulation from a Python environment (recommended) or to run it directly from the terminal. Either option is possible with NetCDF format input files, however ASCII input files must be run directly from the terminal. + +**Running via Python** + +To run a Swiftest simulation from the same script in which the initial conditions are created, simply add the following line after you have finished defining parameters and adding bodies to the simulation: + +``` +sim.run() +``` + +To run a previously created set of initial conditions, first read the old output file into Python, and then run it. Note that Swiftest will look in the ```/simdata``` subdirectory for the initial conditions by default. You may set a new path to the initial conditions using the ```param_file``` keyword argument. + +``` +sim = swiftest.Simulation(simdir = "directory_name", read_old_output=True) +sim.run() +``` + +**Running via a Terminal** + +When creating a new Swiftest simulation, ensure that all required input files exist in a unique directory. A symbolic link to the Swiftest driver should also exist in the simulation directory. To create a symbolic link to the Swiftest driver from your current directory, type: + +``` +$ ln -s ~/PATH/TO/swiftest/bin/swiftest_driver . +``` + +To run Swiftest, simply type the following command into the terminal: + +``` +$ ./swiftest_driver INTEGRATOR param.in +``` + +Where ```INTEGRATOR``` is your integrator of choice, either ```whm```, ```rmvs```, ```helio```, or ```symba```. + **Outputs** -Swiftest generates between 1 and 6 output files, depending on the parameters defined in the **param.in**. The output files are as follows: -- **out.nc** - Always generated, the output file containing the information for every body in the system, written every ```ISTEP_OUT``` timesteps, NetCDF file format only -- **discard.out** - The output file containing the information for every body in the system and all discarded bodies, only if ```BIG_DISCARD``` is ```YES```, ASCII file format only -- **fraggle.log** - The log containing the record of each fragmentation event, including the properties of the colliding bodies, the collisional regime, and the properties of the fragments created, only if ```FRAGMENTATION``` is ```YES```, SyMBA only, ASCII file format only -- **encounter_check_plpl_timer.log** - The log containing the encounter check timer for each massive body/massive body encounter, only if ```ENCOUNTER_CHECK``` is ```ADAPTIVE```, ASCII file format only -- **encounter_check_pltp_time.log** - The log containing the encounter check timer for each massive body/test particle encounter, only if ```ENCOUNTER_CHECK``` is ```ADAPTIVE```, ASCII file format only -- **interaction_timer.log** - The log containing the interaction loop timer for each interacting pair of bodies, only if ```INTERACTION_LOOPS``` is ```ADAPTIVE```, ASCII file format only +The number and type of output files generated by Swiftest depends on the input parameters selected and the method through which Swiftest was run. The standard output files are as follows: +- **data.nc** - Always generated, the output file containing the information for every body in the system, recorded every ```ISTEP_OUT``` timesteps and written every ```DUMP_CADENCE```. This file can be analyzed using the Swiftest Python package (```sim.data```). +- **fraggle.log** - The log containing the record of each fragmentation event, including the collisional regime, and the number of the fragments created, only if ```FRAGMENTATION``` is ```YES```, Swiftest SyMBA only. +- **swiftest.log** - A log containing a brief updated on the status of the run. Only generated if Swiftest is run through the Python package. If Swiftest is run through the terminal, these updates are output directly to the terminal. +- **collision_xxxxxx.nc** - The details of each collision that occurs in a simulation are recorded in a NetCDF file. Each collision receives its own file. These files are consolidated and can be analyzed using the Swiftest Python package (```sim.collisions```). Only if ```CHK_CLOSE```/```close_encounter_check``` is ```YES```/```True```. +- **encounter_xxxxxx.nc** - The details of each close encounter that occurs in a simulation are recorded in a NetCDF file. Each encounter receives its own file. These files are consolidated and can be analyzed using the Swiftest Python package (```sim.encounters```). Only if ```CHK_CLOSE```/```close_encounter_check``` is ```YES```/```True```. +- **init_cond.nc** - The initial conditions used to run the simulation. This file can be analyzed using the Swiftest Python package (```sim.init_cond```). +- **encounter_check_plpl_timer.log** - The log containing the encounter check timer for each massive body/massive body encounter, only if ```CHK_CLOSE```/```close_encounter_check``` is ```YES```/```True``` and ```ENCOUNTER_CHECK```/```encounter_check_loops``` is ```ADAPTIVE```. +- **encounter_check_pltp_time.log** - The log containing the encounter check timer for each massive body/test particle encounter, only if ```CHK_CLOSE```/```close_encounter_check``` is ```YES```/```True``` and ```ENCOUNTER_CHECK```/```encounter_check_loops``` is ```ADAPTIVE```. +- **interaction_timer.log** - The log containing the interaction loop timer for each interacting pair of bodies, only if ```INTERACTION_LOOPS``` is ```ADAPTIVE```. + +To read in a Swiftest output file, simply create a new Python script in the simulation directory. + +``` +import swiftest +sim = swiftest.Simulation(simdir = "directory_name", read_old_output=True) +``` + +All Swiftest data is now stored in the Xarray dataset ```sim.data``` and is easily processed, manipulated, and analyzed. -Each time Swiftest writes to the output files, it also writes a short update to the terminal. At the start of the simulation, it outputs all user parameters set in the **param.in** to the terminal. Each subsequent output is then appended beneath the listed parameters in the following fashion: +Regardless of whether the status outputs are recorded in the **swiftest.log** or in the terminal, the output format is the same. Below is an example of a single status output: `````` Time = 1.00000E+03; fraction done = 0.001; Number of active plm, pl, tp = 57, 108, 50 @@ -254,37 +314,37 @@ Time = 1.00000E+03; fraction done = 0.001; Number of active plm, pl, tp = 5 Integration steps: Total wall time: 2.99848E+02; Interval wall time: 9.36192E+01;Interval wall time/step: 4.68956E-04 `````` -The first line includes the simulation time, the fraction of the simulation that is complete relative to ```tmax```, the number of fully-interactive massive bodies (```plm```), the total number of massive bodies (```pl```) including fully-interactive and semi-interactive bodies, and the number of test particles (```tp```) remaining in the system at that time. The second line includes the angular momentum error, the change in energy as a result of collisions only, the total change in energy, and the change in mass up to this point in the simulation. The third line contains the total wall time elapsed since the start of the simulation, the wall time elapsed since the start of the last step, and the average wall time per step since the start of the simulation. +The first line includes the simulation time, the fraction of the simulation that is complete relative to ```tstop```, the number of fully-interactive massive bodies (```plm```) (SyMBA only), the total number of massive bodies (```pl```) including fully-interactive and semi-interactive bodies, and the number of test particles (```tp```) remaining in the system at that time. The second line includes the angular momentum error, the change in energy as a result of collisions only, the total change in energy, and the change in mass up to this point in the simulation (error analysis included only if ```ENERGY```/```compute_conservation_values``` is set to ```YES```/```True```). The third line contains the total wall time elapsed since the start of the simulation, the wall time elapsed since the start of the last step, and the average wall time per step since the start of the simulation. **Restarting a Simulation From t $\neq$ 0** -Swiftest allows the user to restart a simulation in two different ways. Restarting from the dump files is ideal if there is a risk that the simulation was terminated in the writing stage or if the output was corrupted during termination. Restarting from a timestamp is ideal if the point at which the user would like to restart from is not the last timestep written to the output file. Both ways allow the user to restart a simulation from the last timestep written to the output file. +Just like Swiftest allows the user to run a simulation through the terminal or through Python, Swiftest also allows the user to restart a simulation from t $\neq$ 0 in the same two manners. This can be useful in the case of an accidental termination of a simulation, such as through a power outage or computer failure. In many cases, it is also necessary to run a simulation to a new end point, past the original ```TSTOP```. -In case of accidental termination of a simulation, such as through a power outage or computer failure, Swiftest generates a series of dump files. Every ```ISTEP_DUMP``` timesteps, Swiftest dumps all simulation information to the dump files. Every ```ISTEP_DUMP``` timestep, Swiftest alternates which set of dump files to dump to (either set "1" or set "2"). This way, even if Swiftest is terminated during the writing stage, at least one set of dump files is preserved and the information is not lost. When Swiftest is restarted from a dump file, it automatically determines which set of dump files has proceeded further in simulation time, and picks up from that point. +**Restarting via Python** -The Dump Files: -- **dump_param1.in** - The file storing all simulation parameters for set 1 of the dump files, ASCII file format only -- **dump_param2.in** - The file storing all simulation parameters for set 2 of the dump files, ASCII file format only -- **dump_bin1.nc** or **dump_bin1.dat** - The file storing all simulation information for set 1 of the dump files, NetCDF file format -- **dump_bin2.nc** or **dump_bin2.dat** - The file storing all simulation information for set 2 of the dump files, NetCDF file format - -To run Swiftest from a dump file, simply type the following command into the terminal: +To restart a Swiftest simulation via the Swiftest Python package, follow the outline below: ``` -$ ./swiftest_driver INTEGRATOR DUMP_PARAM +import swiftest +sim = swiftest.Simulation(simdir = "directory_name", read_old_output=True) +sim.set_parameter(tstop=VAL) # Set a new stop time if desired +sim.write_param() # Write simulation parameters to the param.in +sim.run() ``` -Where ```INTEGRATOR``` is your integrator of choice, either ```whm```, ```rmvs```, ```helio```, or ```symba```, and ```DUMP_PARAM``` is either **dump_param1.in** or **dump_param2.in**. The option of specifying **dump_param1.in** or **dump_param2.in** is included for backwards compatibility. Swiftest will still automatically check which dump file has progressed further and select that dump file, regardless of your choice of dump parameter file. If you would like to force Swiftest to select one dump parameter file over the other, simply delete the set of dump files that you do not want. +Note that Swiftest will look in the ```/simdata``` subdirectory for the initial conditions by default. You may set a new path to the initial conditions using the ```param_file``` keyword argument. -While the dump files allow the user to restart only from the last recorded step, Swiftest also allows the user to restart a run from an earlier point. This can be useful if the user wishes to clone the number of test particles in a simulation at a certain time or isolate a particular event. To generate a new set of initial conditions from a set time in a preexisting run, use the Swiftest Python package to read in the **out.nc** output file (see the **Swiftest Python Package** section for more details). Next, use the ```initial_conditions_from_bin``` method, part of the ```swiftest.Simulation``` class. This method takes the frame number from which to generate a set of initial conditions as the sole argument. An example of this process is shown below: +**Restarting via a Terminal** -``` -import swiftest # Import the Swiftest Python package. -sim = swiftest.Simulation(param_file="param.in") # Read in the output of a past simulation and store it in the sim object. -sim.initial_conditions_from_bin(framenum=3) # Generate a new set of initial conditions from frame 3 of the past simulation stored in sim. -``` +Every ```DUMP_CADENCE``` X ```ISTEP_OUT``` timesteps, Swiftest writes all simulation information from memory to the output files. At the same time, Swiftest also writes all simulation information to one of two sets of dump files, alternating between sets at each subsequent dump. This way, even if Swiftest is terminated during the writing stage, at least one set of dump files is preserved and the information is not lost. When Swiftest is restarted from a dump file, it automatically determines which set of dump files has proceeded further in simulation time, and picks up from that point. + +The Dump Files: +- **dump_param1.in** - The file storing all simulation parameters for set 1 of the dump files, ASCII file format only +- **dump_param2.in** - The file storing all simulation parameters for set 2 of the dump files, ASCII file format only +- **dump_bin1.nc** or **dump_bin1.dat** - The file storing all simulation information for set 1 of the dump files, NetCDF file format +- **dump_bin2.nc** or **dump_bin2.dat** - The file storing all simulation information for set 2 of the dump files, NetCDF file format -To calculate the frame number that correlates to a particular time in a simulation, the simulation's output cadence (```ISTEP_OUT```) and timestep (```DT```) must be considered. New initial conditions can only be generated from old output frames, so if the desired time falls between output steps, it is necessary to generate initial conditions from the previous output step. For example, a simulation that ran from 0 to 100 years, where ```DT``` = 1 year and ```ISTEP_OUT``` = 10, will output every 10 timesteps, or every 10 years. If the user wishes to generate new initial conditions at 34 years, it is necessary to select frame number 3, which correlates to 30 years. The new simulation can then be run with shorter a output cadence and/or timestep if desired. +To restart Swiftest from a dump file, simply follow the instructions detailed in the **Running via a Terminal** section, replacing ```PARAM``` with either **dump_param1.in** or **dump_param2.in**. The option of specifying **dump_param1.in** or **dump_param2.in** is included for backwards compatibility. Swiftest will still automatically check which dump file has progressed further and select that dump file, regardless of your choice of dump parameter file. If you would like to force Swiftest to select one dump parameter file over the other, simply delete the set of dump files that you do not want. --- @@ -292,137 +352,39 @@ To calculate the frame number that correlates to a particular time in a simulati **Fraggle** -To activate the Fraggle algorithm, set ```FRAGMENTATION``` in the **param.in** to ```YES```. When resolving a close encounter that results in a collision, Fraggle determines the regime of the collision as well as the mass, number, position, velocity, and rotation of all resulting bodies. This is distinct from Swiftest SyMBA's predecessor, Swifter SyMBA, which assumes that all collisions result in perfect mergers. +To activate the Fraggle algorithm, set ```FRAGMENTATION```/```fragmentation``` to ```YES```/```True```, depending on the mode in which Swiftest is being run. When resolving a close encounter that results in a collision, Fraggle determines the regime of the collision as well as the mass, number, position, velocity, and rotation of all resulting bodies. This is distinct from Swiftest SyMBA's predecessor, Swifter SyMBA, which assumes that all collisions result in perfect mergers. -Fraggle distinguishes the following collisional regimes: (1) perfect merging, which includes the cratering, partial accretion, and graze-and-merge regimes of Leinhardt & Stewart 2012, (2) disruption, which includes the partial erosion regime of Leinhardt & Stewart 2012, (3) super-catastrophic disruption, and (4) hit-and-run events which can be either ‘pure’ or ‘disruptive’. For more details on the collisional regimes used in Fraggle, please see Wishard et al. 2023 (in preparation). +Fraggle distinguishes the following collisional regimes: (1) perfect merging, which includes the cratering, partial accretion, and graze-and-merge regimes of Leinhardt & Stewart 2012, (2) disruption, which includes the partial erosion regime of Leinhardt & Stewart 2012, (3) super-catastrophic disruption, and (4) hit-and-run events which can be either ‘pure’ or ‘disruptive’. -For every collision throughout the course of a simulation, Fraggle writes all details of the collision to the **fraggle.log** output file. An example of a collision, stored in the **fraggle.log** output file, is as follows: +For every collision throughout the course of a simulation, Fraggle writes a brief description of the collision to the **fraggle.log** output file. An example of a collision, stored in the **fraggle.log** output file, is as follows: ``` Fraggle logfile - ********************************************************************************************************************** - Collision between massive bodies detected at time t = 53287.8837501905 + ********************************************************************************************************************** + Collision between massive bodies detected at time t = 2.063709800335315E-006 ********************************************************************************************************************** -------------------------------------------------------------------- Fraggle collisional regime determination results -------------------------------------------------------------------- - ----------------------- Collider information ----------------------- - True number of colliders : 2 - Index list of true colliders : 46 59 - -------------------- Two-body equivalent values --------------------- - mass1 : 7.279963439341357E-008 - radius1 : 1.509673399450197E-005 - xb1 : -0.164526979999547 0.274220676062862 -1.874872430483121E-003 - vb1 : -10.3604371489563 -6.86832326672301 0.784240412278650 - rot1 : 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - Ip1 : 0.400000000000000 0.400000000000000 0.400000000000000 - L_spin1 : 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - L_orbit1 : 2.025082559023084E-013 -4.805611941169830E-014 8.130853354510135E-014 - mass2 : 3.639981719670679E-008 - radius2 : 1.198228571207825E-005 - xb2 : -0.164537935569248 0.274203936567747 -1.857479937042359E-003 - vb2 : -9.62196685949397 -6.65749989216304 -0.930400979141005 - rot2 : 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - Ip2 : 0.400000000000000 0.400000000000000 0.400000000000000 - L_spin2 : 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - L_orbit2 : 4.050165118023079E-013 -9.611223882570558E-014 1.626170670889251E-013 - ------------------------------ Regime ----------------------------- - Supercatastrophic disruption - ----------------------- Fragment information ---------------------- - Total mass of fragments : 1.091994515901204E-007 - Largest fragment mass : 6.712252746514322E-009 - Second-largest fragment mass : 2.697031548515946E-009 - Remaining fragment mass : 9.979016729509007E-008 - Center of mass position : -0.164530631856114 0.274215096231157 -1.869074932669534E-003 - Center of mass velocity : -10.1142803858022 -6.79804880853635 0.212693281805431 - Energy loss : 4.042796382680678E-021 + True number of colliders : 2 + Index list of true colliders : 1 2 + Regime: Disruption + Energy loss : 2.298848838233116E-022 -------------------------------------------------------------------- - Supercatastrophic disruption between Embryo_108 (17) and Planetesimal_165 (74) - Fraggle generating 25 fragments. - Fraggle try 1 - Fraggle failed due to high energy error: 2.228292487416184E-006 222.829248791199 + Disruption between Target (1) and Projectile (2) + Fraggle generating 28 fragments. Fraggle try 1 - Fraggle fragment generation succeeded after 2 tries + Fraggle fragment generation succeeded after 1 tries + Generating 28 fragments +``` - -------------------------------------------------------------------- - Fraggle fragment generation results - -------------------------------------------------------------------- - dL_tot should be very small - dL_tot | 4.7581E-18 - dE_tot should be negative and equal to Qloss - dE_tot |-6.4291E-16 - Qloss |-1.4019E-18 - dE - Qloss |-6.4151E-16 - ------------------------------------------------------------------------------------- - Individual fragment values (collisional system natural units) - mass - 1 6.146782468934672E-002 - ... - 25 9.385003231486798E-003 - x_coll - 1 0.316962058114018 -3.455343819627035E-002 -0.300006155462737 - ... - 25 -0.815265667032389 0.366308046064501 -2.21749663921913 - v_coll - 1 5.313828153210731E-002 -4.301810302840381E-003 -4.677161223686286E-002 - ... - 25 -6.377609897296144E-002 6.344417215259035E-002 -0.181654563778228 - xb - 1 -6075.62794432757 10126.4434063427 -69.3229971249382 - ... - 25 -6076.76017205272 10126.8442678270 -71.2404876086946 - vb - 1 -1.11732916805166 -0.791000868225230 -2.215784303111038E-002 - ... - 25 -1.23424354855673 -0.723254885769800 -0.157040794572475 - rot - 1 1.524406714701067E-002 -3.617486407307866E-003 6.120533573657602E-003 - ... - 25 0.349507539640067 -8.293972741700310E-002 0.140328208343859 - Generating 25 fragments +The details of the collision are stored in the simulation object (```sim.collisions```) which can be accessed using the Swiftest Python package. - -------------------------------------------------------------------- - Fraggle fragment final body properties - -------------------------------------------------------------------- - id, name - 1 159 Newbody0000159 - ... - 25 183 Newbody0000183 - mass, Gmass - 1 6.712252746514322E-009 2.649791077120669E-007 - ... - 25 1.024837206049866E-009 4.045742296433080E-008 - radius - 1 6.820183146057143E-006 - ... - 25 3.645229682479472E-006 - xb - 1 -0.164522048834296 0.274214160557923 -1.877198805265405E-003 - ... - 25 -0.164552708451177 0.274225015493955 -1.929122567862225E-003 - vb - 1 -9.65510018491191 -6.83522174793328 -0.191471054783233 - ... - 25 -10.6653844315872 -6.24981301930138 -1.35702588643539 - xh - 1 -0.163736684665089 0.275484908115360 -1.873622658345619E-003 - ... - 25 -0.163767344281971 0.275495763051392 -1.925546420942439E-003 -vh - 1 -9.65588432804781 -6.83327438044371 -0.191474942854245 - ... - 25 -10.6661685747231 -6.24786565181180 -1.35702977450640 - rot - 1 4864.55998519625 -1154.38219041380 1953.13379450074 - ... - 25 111531.940620641 -26467.0363417388 44780.3713090889 - Ip - 1 0.400000000000000 0.400000000000000 0.400000000000000 - ... - 25 0.400000000000000 0.400000000000000 0.400000000000000 -``` +**Encounter Trajectory Saving** + +DO THIS **General Relativity** @@ -482,136 +444,7 @@ Together, adaptive interaction calculations and encounter checking are idea for The NetCDF (Network Common Data Form) file format is a cross-platform method of creating, accessing, and sharing data. Due to its self-describing nature, NetCDF is ideal for archiving multidimensional scientific data. NetCDF files are also appendable, allowing for data to be added to a file after creation, making the NetCDF file format well suited for handling simulation output. NetCDF is maintained by the University Corporation for Atmospheric Research (UCAR) and is a standard file format across much of the atmospheric modeling community. In Swifter SyMBA, simulation outputs were stored in a flat binary file. These binary files could only be easily accessed through [SwiftVis](https://cs.trinity.edu/~mlewis/SwiftVis/), a data analysis and visualization software package designed to process Swifter data. In accordance with modern data management practices and industry standards, Swiftest incorporates a NetCDF output file format for all simulation types. NetCDF is compatible with many of today's most widely-used programming languages including Fortran, Python, Java, C++, and more. By writing simulation data to a NetCDF output file, Swiftest provides the user with the flexibility to analyze and visualize data in any language they choose. The NetCDF file format is also adaptable such that any future additions to Swiftest can be seamlessly incorporated into the output file. - -**Swiftest Python Package** - -Included with Swiftest, in the ```/swiftest/python/swiftest/``` directory, is a Python package designed to fascilitate seamless data processing and analysis. The Python package, also called Swiftest, can be used to generate input files and process output files in the NetCDF file format. - -To begin, Swiftest can be added to an existing conda environment, or a new conda environment may be created, so long as the required pacakges are installed. To create and activate a new conda environment with the prerequisite packages, open a terminal and navigate to the ```/swiftest/python/swiftest/``` directory. Type the following: - -``` -$ conda create --name EnvName pip scipy numpy matplotlib pandas xarray jupyter astropy -y -$ conda activate EnvName -``` - -Next, we will install further required pacakges. Using the ```-e``` flag imports all packages in ```/swiftest/python/swiftest/requirements.txt```, including Swiftest. If the Swiftest Python package is updated in the future, using the ```-e``` flag should ensure that the user does not have to reinstall the pacakge to use the updated verison. - -``` -$ pip install pySLALIB -$ pip install -e . -``` - -The Swiftest Python package should now be installed in the conda environment and is ready to use. If you would like to take the further step to add Swiftest to a Jupyter Notebook kernel, type the following: - -``` -$ ipython kernel install --user --name EnvName --display-name "Swiftest Kernel" -``` - -Now that Swiftest has been added to your Python environment, generating an initial conditions file is relatively straightforward. To begin, simply create a new Python script in the simulation directory. The initial conditions script must contain all information for the **param.in** and all initial condition information for the bodies added to the simulation. All of this information can be changed later by directly editing the input files. - -Open the new script, import the Swiftest Python package, and initialize the Swiftest simulation as an object. Various attributes can be attached to the simulation object, including all parameter information. - -``` -import swiftest # Importing Swiftest -sim = swiftest.Simulation() # Initializing the simulation object -sim.param['T0'] = 0.0 # An example of how to attach a parameter to the simulation object. This parameter will be added to the param.in -``` - -The Swiftest Python package also interfaces with the [NASA JPL Horizons database](https://ssd.jpl.nasa.gov/horizons/), allowing a user to easily import the initial conditions of known solar system bodies using the ```add``` function. - -``` -sim.add("Mercury") # An example of how to add a known body from the JPL Horizons database to a Swiftest simulation. -``` - -User defined bodies can also be added to a Swiftest simulation through the Python package. To add massive bodies using the ```addp``` function, define an ```IN_FORM``` and then add all desired initial conditions. The first 8 arguments (the id, the name, and either the cartesian state vectors or the orbital elements, depending on the value of ```IN_FORM```) are required, while the last 9 arguments (the gravitational mass, the radius, the Hill Radius, the principal moments of inertia, and the rotation vector) are optional. The ```addp``` function accepts single values or arrays of values. - -``` -sim.param['IN_FORM'] = "EL" # Set the in form to be orbital elements. Can also set to cartesian state vectors using XV. -sim.addp(id, name, a, e, inc, capom, omega, capm, GMpl=GMpl, Rpl=Rpl, rhill=rhill, Ip1=Ip1, Ip2=Ip2, Ip3=Ip3, rotx=rotx, roty=roty, rotz=rotz) # An example of how to add a user defined body to a Swiftest simulation. -``` - -Once all desired bodies and parameters are added to the simulation object, the information is saved to a set of initial condition files (**param.in**, **cb.in**, **pl.in**, **tp.in**) using the following line: - -``` -sim.save('param.in') # Saving the Swiftest input files. -``` - -The input files necessary to successfully run Swiftest should now be generated in the simulation directory. - -To read in a Swiftest output file, create a new Python script in the simulation directory. We recommend using [Xarray](https://docs.xarray.dev/en/stable/index.html) to manage and process output files. - -``` -import swiftest # Importing Swiftest -import xarray as xr # Importing Xarray -ds = swiftest.Simulation(param_file="PATH/TO/param.in").ds # Storing all simulation data to an Xarray dataset. -``` - -All Swiftest data is now stored in the Xarray dataset ```ds``` and is easily processed, manipulated, and analyzed. The NetCDF output file stores data in two dimensions: simulation time (```time```) and particle ID (```id```). The NetCDF output file contains a maximum of 60 data variables. Below is a list of all data variables and their associated dimension. - -| Data Variable Name | Data Variable Description | Data Variable Dimension | -|------------------------|------------------------------------------------------------------------------------------------------------------------------------------------------------|-------------------------| -| ```npl``` | Number of massive bodies | time | -| ```ntp``` | Number of test particles | time | -| ```nplm``` | Number of massive bodies above the ```GMTINY``` cutoff value | time | -| ```name``` | Name of particle | id | -| ```particle_type``` | Particle type (Central Body, Massive Body, or Test Particle) | id | -| ```status``` | Particle status (Active, collisional regime, discard fate etc.) | id | -| ```xhx``` | Heliocentric x-coordinate of position in distance units, only if ```OUT_FORM``` in the **param.in** is set to ```XV``` or ```XVEL``` | time, id | -| ```xhy``` | Heliocentric y-coordinate of position in distance units, only if ```OUT_FORM``` in the **param.in** is set to ```XV``` or ```XVEL``` | time, id | -| ```xhz``` | Heliocentric z-coordinate of position in distance units, only if ```OUT_FORM``` in the **param.in** is set to ```XV``` or ```XVEL``` | time, id | -| ```vhx``` | Heliocentric x-coordinate of velocity in distance and time units, only if ```OUT_FORM``` in the **param.in** is set to ```XV``` or ```XVEL``` | time, id | -| ```vhy``` | Heliocentric y-coordinate of velocity in distance and time units, only if ```OUT_FORM``` in the **param.in** is set to ```XV``` or ```XVEL``` | time, id | -| ```vhz``` | Heliocentric z-coordinate of velocity in distance and time units, only if ```OUT_FORM``` in the **param.in** is set to ```XV``` or ```XVEL``` | time, id | -| ```a``` | Semi-major axis in distance units, only if ```OUT_FORM``` in the **param.in** is set to ```EL``` or ```XVEL``` | time, id | -| ```e``` | Eccentricity, only if ```OUT_FORM``` in the **param.in** is set to ```EL``` or ```XVEL``` | time, id | -| ```inc``` | Inclination in degrees, only if ```OUT_FORM``` in the **param.in** is set to ```EL``` or ```XVEL``` | time, id | -| ```capom``` | Longitude of ascending node, only if ```OUT_FORM``` in the **param.in** is set to ```EL``` or ```XVEL``` | time, id | -| ```omega``` | Argument of pericenter, only if ```OUT_FORM``` in the **param.in** is set to ```EL``` or ```XVEL``` | time, id | -| ```capm``` | Mean anomaly, only if ```OUT_FORM``` in the **param.in** is set to ```EL``` or ```XVEL``` | time, id | -| ```Gmass``` | G * mass in mass units | time, id | -| ```rhill``` | Hill Radius in distance units | time, id | -| ```radius``` | Radius in distance units | time, id | -| ```origin_time``` | Time of particle creation in simulation time in time units | id | -| ```origin_type``` | Type of creation (Initial conditions, Hit and run fragment etc.) | id | -| ```origin_xhx``` | Heliocentric x-coordinate of origin position in distance units | id | -| ```origin_xhy``` | Heliocentric y-coordinate of origin position in distance units | id | -| ```origin_xhz``` | Heliocentric z-coordinate of origin position in distance units | id | -| ```origin_vhx``` | Heliocentric x-coordinate of origin velocity in distance units | id | -| ```origin_vhy``` | Heliocentric y-coordinate of origin velocity in distance units | id | -| ```origin_vhz``` | Heliocentric z-coordinate of origin velocity in distance units | id | -| ```collision_id``` | Collision number in which particle was formed | id | -| ```discard_time``` | Time of particle discard in simulation time in time units | id | -| ```discard_xhx``` | Heliocentric x-coordinate of discard position in distance units | id | -| ```discard_xhy``` | Heliocentric y-coordinate of discard position in distance units | id | -| ```discard_xhz``` | Heliocentric z-coordinate of discard position in distance units | id | -| ```discard_vhx``` | Heliocentric x-coordinate of discard velocity in distance units | id | -| ```discard_vhy``` | Heliocentric y-coordinate of discard velocity in distance units | id | -| ```discard_vhz``` | Heliocentric z-coordinate of discard velocity in distance units | id | -| ```discard_body_id``` | ID of the other body involved in the discard, 0 if no other body involved | id | -| ```Ip1``` | Principal moment of inertia axis 1, only if ```ROTATION``` in the **param.in** is set to ```YES``` | time, id | -| ```Ip2``` | Principal moment of inertia axis 2, only if ```ROTATION``` in the **param.in** is set to ```YES``` | time, id | -| ```Ip3``` | Principal moment of inertia axis 3, only if ```ROTATION``` in the **param.in** is set to ```YES``` | time, id | -| ```rotx``` | X-coordinate of particle rotation in radians / second, only if ```ROTATION``` in the **param.in** is set to ```YES``` | time, id | -| ```roty``` | Y-coordinate of particle rotation in radians / second, only if ```ROTATION``` in the **param.in** is set to ```YES``` | time, id | -| ```rotz``` | Z-coordinate of particle rotation in radians / second, only if ```ROTATION``` in the **param.in** is set to ```YES``` | time, id | -| ```KE_orb``` | Orbital kinetic energy of the system | time | -| ```KE_spin``` | Rotational kinetic energy of the system | time | -| ```PE``` | Potential energy of the system | time | -| ```L_orbx``` | Heliocentric x-coordinate of orbital angular momentum of the system | time | -| ```L_orby``` | Heliocentric y-coordinate of orbital angular momentum of the system | time | -| ```L_orbz``` | Heliocentric z-coordinate of orbital angular momentum of the system | time | -| ```L_spinx``` | Heliocentric x-coordinate of rotational angular momentum of the system | time | -| ```L_spiny``` | Heliocentric y-coordinate of rotational angular momentum of the system | time | -| ```L_spinz``` | Heliocentric z-coordinate of rotational angular momentum of the system | time | -| ```L_escapex``` | Heliocentric x-coordinate of orbital angular momentum of bodies that were discarded from the system due to being too far from the central body | time | -| ```L_escapey``` | Heliocentric y-coordinate of orbital angular momentum of bodies that were discarded from the system due to being too far from the central body | time | -| ```L_escapez``` | Heliocentric z-coordinate of orbital angular momentum of bodies that were discarded from the system due to being too far from the central body | time | -| ```Ecollisions``` | Energy lost due to collisions | time | -| ```Euntracked``` | Energy of bodies that were discarded from the system due to being too far from the central body, untracked potential energy due to merging bodies | time | -| ```GMescape``` | G * mass of particles that were discarded from the system due to being too far from the central body | time | -| ```j2rp2``` | The J2 / R^2 term of the central body | time | -| ```j4rp4``` | The J4 / R^2 term of the central body | time | - + **Object-Oriented Programming** The 2003 version of Fortran introduced object-oriented programming, with Fortran 2008 providing further updates. Swiftest is written in modern Fortran and takes advantage of many of the object-oriented programming features included in Fortran 2003. In doing so, Swiftest is a complete restructure of its predecessor, Swifter. The reusability and simplification of code in Swiftest through object-oriented programming is a modern and flexible approach that allows for future enhancements and additions to the Swiftest package. @@ -624,9 +457,9 @@ Parallelization using OpenMP is still under development in Swiftest. For prelimi #### Examples -All examples are included in the ```/swiftest/examples/``` directory. To run the initial conditions, follow the steps included in the **Usage** section. See the **README.txt** included in each example directory for more details. +All examples are included in the ```/swiftest/examples/``` directory. Simply run the script(s) included in the directory as you would normally run a Python script. See the **README.txt** included in each example directory for more details. -**Standard Simulation Setup** +**Basic_Simulation** This example walks through how to set up a standard solar system simulation. It can be found in the ```/swiftest/examples/Basic_Simulation``` directory. It is intended to be run using the SyMBA integrator. It contains three classes of bodies: - Fully-Interacting Massive Bodies - Gravitational affect and are affected by other massive bodies. @@ -643,7 +476,7 @@ This example highlights the functionality of the Fraggle algorithm. It can be fo - An Off-Axis Supercatastrophic Disruptive Collision - A Disruptive Hit and Run Collision -For more details on the collisional regimes used in Fraggle, please see Wishard et al. 2023 (in preparation). +To generate a movide depicting the collision and results of each test case, run the Python script titled **Fragmentation_Movie.py**. **Comparison with Swifter SyMBA** @@ -663,19 +496,17 @@ After 1 My, there is good agreement between Swiftest SyMBA and Swifter SyMBA in A good rule is to set ```dt``` equal to one tenth the orbit of the inner-most body in your simulation. For example, if Mercury is your inner-most body, ```dt``` should be set to one tenth Mercury's orbit. Mercury's orbit is ~0.24 years (~88 days) so a timestep of 0.024 years should be sufficiently small to accurately model the orbit of Mercury. You can always go smaller to increase resolution. -**How often should I output (**```ISTEP_OUT```**)?** - -Depending on your simulation, you may want to write to the output file more or less frequently. Writing takes a considerable amount of computational time, so it is important to set a output cadence that is manageable. Writing too frequently can also create extremely large and unwieldy output files, making data processing difficult. There is no hard and fast rule for how often you should output, however it is dependent on your total simulation length (```tmax```) and your timestep (```dt```). For example, an appropriate output cadence for run with a timestep of 0.005 years and a total simulation length of 100 My might be 2e5. This means that the output file will be written to every 2e5 timesteps. Based on our value of ```dt```, this is every 1,000 years. Our total simulation length tells us that we will output 100,000 times over the course of the simulation. For longer simulations, the output cadence may be less frequent to save computational space. For shorter simulations, the output cadence may be more frequent to increase resolution. +**How often should I output (**```ISTEP_OUT``` **and** ```DUMP_CADENCE```**)?** -**How often should I write to the dump files (**```ISTEP_DUMP```**)?** +Depending on your simulation, you may want to write to the output file more or less frequently. Writing takes a considerable amount of computational time, so it is important to set a output cadence that is manageable. Conversely, storing data in memory may not be reasonable for all simualtion configurations or hardware, so writing more frequently may be necessary. There is no hard and fast rule for how often you should output, however it is dependent on your total simulation length (```tmax```) and your timestep (```dt```). Think of ```ISTEP_OUT``` as the number of timesteps between writing to memory, and ```DUMP_CADENCE``` as the number of write to memory operations between writing to file. -Similar to your output cadence, your dump cadence is also dependent on your simulation length and timestep size. Writing to a dump file allows you to restart a simulation after a computer crash, a power outage, a node failure, or after a simulation has finished. This is especially necessary for runs that take weeks or months to finish. It is often convenient to set the dump cadence to the same frequency as the output cadence. This makes intuitive sense and can make restarting a run simple. However, it may be desirable to set the dump cadence higher than the output cadence if you are particularly concerned about interuptions. If you have a simulation that is quick to run and you don't forsee needing to restart it, it may be desirable to simply set the dump cadence such that it only writes to the dump file at the end of the simulation. This way, performance is improved and the dump files are not taking up computational space and memory. +For example, an appropriate output cadence for run with a timestep of 0.005 years and a total simulation length of 100 My might be ```ISTEP_OUT = 2e5``` and ```DUMP_CADENCE = 10```. This means that data will be stores to memory every 2e5 timesteps and written to file every 2e6 timesteps. Based on our value of ```dt```, this is every 1,000 years and every 10,000 years, respectiely. Our total simulation length tells us that we will write to file 10,000 times over the course of the simulation. For longer simulations, the output cadence may be less frequent to save computational space. For shorter simulations, the output cadence may be more frequent to increase resolution. -**What mass threshold should I set to differentiate fully-interactive and semi-interactive bodies (**```GMTINY```**)?** +**What mass threshold should I set to differentiate fully-interactive and semi-interactive bodies (**```GMTINY``` **or** ```MTINY```**)?** Semi-interacting bodies are useful because the integrator is not required to calculate gravitational interactions between pairs of semi-interacting particles. This can result in significant performance improvements, especially for systems that require hundreds or thousands of massive bodies. If your system only has a few tens of massive bodies, semi-interacting bodies may not be necessary. If you would like to differentiate between these two classes of bodies, simply set the mass threshold to be some value between the mass of the smallest fully-interacting body and the mass of the largest semi-interacting body that you choose. Semi-interacting bodies can collide with each other and grow to become fully interacting bodies once they pass the mass threshold. -**What should minimum fragment mass should I use (**```MIN_GMFRAG```**)?** +**What should minimum fragment mass should I use (**```MIN_GMFRAG``` **or** ```MIN_MFRAG```**)?** This mass threshold is necessary to ensure that Swiftest SyMBA does not generate huge amounts of very small fragments, grinding the model to a halt. While this value is largely empirical and dependent on each specific set of initial conditions, a good place to start is to set the minimum fragment mass threshold to be one tenth the size of the smallest body in your simulation. @@ -683,7 +514,7 @@ This mass threshold is necessary to ensure that Swiftest SyMBA does not generate While Swifest SyMBA is a powerful tool for modeling gravitational interactions between massive bodies, it does have its limits. While Swiftest SyMBA is capable of modeling systems containing thousands of massive bodies, the code does slow down significantly. For this reason, Swiftest SyMBA is best used for systems containing tens to hundreds of fully-interacting massive bodies. It is also best used for timescales on the order of a few hundred million years or less. While it is possible to model systems on a billion year timescale, the computational power required may be beyond what is available to the average user. In these cases, it is recommended that the user consider modeling with test particles instead of massive bodies. For systems that contain mainly test particles, with few to no close encounters between massive bodies, Swiftest RMVS is likely a more appropriate tool. An overview of the performance capabilities of Swiftest SyMBA is included in **Figure 3**. -To get a sense of the scope of your desired simulation, it is recommended that you run your initial conditions and parameters for a just few steps. Make sure that you set ```ISTEP_OUT``` and ```ISTEP_DUMP``` to output only once the simulation is complete, not between steps. Because writing to the output files takes a significant amount of computational time compared to integrating the step, we want to avoid counting writing time in our diagnostic information. The terminal output contains information about the total wall time and the wall time per integration step. To get a sense of how long your run will take to complete your desired ```tmax```, simply scale up the wall time per integration step to the number of steps necessary for ```tmax``` to be reached. Remember that writing to the output files will take a considerable amount of time. Adjust your intitial conditions and parameters accordingly. +To get a sense of the scope of your desired simulation, it is recommended that you run your initial conditions and parameters for a just few steps. Make sure that you set ```ISTEP_OUT``` and ```DUMP_CADENCE``` to output only once the simulation is complete, not between steps. Because writing to the output files and memory takes a significant amount of computational time compared to integrating the step, we want to avoid counting writing time in our diagnostic information. The terminal output contains information about the total wall time and the wall time per integration step. To get a sense of how long your run will take to complete your desired ```tmax```, simply scale up the wall time per integration step to the number of steps necessary for ```tmax``` to be reached. Remember that writing to the output files will take a considerable amount of time. Adjust your intitial conditions and parameters accordingly. |![Swiftest SyMBA Performance](README_figs/performance.png "Swiftest SyMBA Performance")| |:--:| diff --git a/README_tables/add_body_kwargs.md b/README_tables/add_body_kwargs.md new file mode 100644 index 000000000..d24dd051b --- /dev/null +++ b/README_tables/add_body_kwargs.md @@ -0,0 +1,21 @@ +# swiftest.add_body(**kwargs) +| Key Word Name | Key Word Description | Options | +|-----------------|-----------------------------------------------------------------------------------------------------------------------------------------|--------------------------------| +| ```name``` | Name(s) of bodies. | string or array-like of strings +| ```id``` | Unique identification value(s) of bodies. | float or array-like of floats +| ```a``` | Semi-major axis value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats +| ```e``` | Eccentricity value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats +| ```inc``` | Inclination value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats +| ```capom``` | Longitude of the ascending node value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats +| ```omega``` | Argument of pericenter value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats +| ```capm``` | Mean anomaly value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats +| ```rh``` | Position vector(s) of bodies. Only used if ```init_cond_format``` is set to ```XV```. | (n,3) array-like of floats +| ```vh``` | Velocity vector(s) of bodies. Only used if ```init_cond_format``` is set to ```XV```. | (n,3) array-like of floats +| ```mass``` | Mass value(s) of bodies. Only for massive bodies. Only ```mass``` **OR** ```Gmass``` may be set. | float or array-like of floats +| ```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. 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 J2 term of the central body. | float or array-like of floats +| ```J4``` | The J4 term of the central body. | float or array-like of floats \ No newline at end of file diff --git a/README_tables/param_options.md b/README_tables/param_options.md new file mode 100644 index 000000000..5f63f3cf8 --- /dev/null +++ b/README_tables/param_options.md @@ -0,0 +1,54 @@ +# **param.in** options +| Parameter Name | Parameter Description | Input Format | Compatible Integrators | +|-------------------------|------------------------------------------------------------------------------------------------------------------------------|---------------------------------------------------------------------------------------------------------|------------------------| +| ```T0``` | The reference time for the start of the simulation in time units. | floating point (ex. ```0.0```) | all +| ```TSTART``` | Simulation start time for a restarted run in time units. | floating point (ex. ```0.0```) | all +| ```TSTOP``` | Simulation end time in time units. Must be greater than ```TSTART```. | floating point (ex. ```100.0```) | all +| ```DT``` | Simulation step size in time units. Must be less than or equal to ```TSTOP```-```TSTART```. | floating point (ex. ```0.005```) | all +| ```ISTEP_OUT``` | The number of time steps (```DT```) between output saves to memory. | integer (ex. ```200```) | all +| ```DUMP_CADENCE``` | The number of output steps between when data saved to memory is written to file. Setting to ```0``` results in writing data to file only at the completion of the simulation. | integer (ex. ```100```) | all +| ```IN_TYPE``` | Input file format. | ```ASCII```, ```NETCDF_FLOAT```, and ```NETCDF_DOUBLE``` | all +| ```NC_IN``` | NetCDF input file name. Only if ```IN_TYPE``` is set to ```NETCDF_FLOAT``` or ```NETCDF_DOUBLE```. | string (ex. ```init_cond.nc```) | all +| ```PL_IN``` | Massive body input file name. Only if ```IN_TYPE``` is set to ```ASCII```. | string (ex. ```pl.in```) | all +| ```TP_IN``` | Test particle input file name. Only if ```IN_TYPE``` is set to ```ASCII```. | string (ex. ```tp.in```) | all +| ```CB_IN ``` | Central body input file name. Only if ```IN_TYPE``` is set to ```ASCII```. | string (ex. ```cb.in```) | all +| ```IN_FORM``` | Input format. | ```EL```, ```XV``` | all +| ```OUT_TYPE``` | Output file format. | ```NETCDF_FLOAT```, ```NETCDF_DOUBLE``` | all +| ```BIN_OUT``` | Output file name. | string (ex. ```bin.nc```) | all +| ```OUT_FORM``` | Output format. | ```XV```, ```XVEL``` | all +| ```OUT_STAT``` | Output status. | ```NEW```, ```APPEND```, ```REPLACE```, ```UNKNOWN``` | all +| ```CHK_QMIN``` | Pericenter distance at which a test particle is too close to the pericenter of the system in distance units. | floating point, turn off using ```-1.0``` | all +| ```CHK_RMIN``` | Heliocentric distance at which a test particle is considered merged with the central body in distance units. | floating point, turn off using ```-1.0``` | all +| ```CHK_RMAX``` | Heliocentric distance at which a test particle is too distant from the central body in distance units. | floating point (ex. ```1000.0```) | all +| ```CHK_EJECT``` | Heliocentric distance at which an unbound test particle is too distant from the central body in distance units. | floating point (ex. ```1000.0```) | all +| ```CHK_QMIN_COORD``` | Coordinate frame used to check for minimum pericenter distance. | ```HELIO```, ```BARY``` | all +| ```CHK_QMIN_RANGE``` | Upper and lower bounds of the semimajor axis range used to check the pericenter distance. | two floating points, turn off using ```-1.0 -1.0``` | all +| ```EXTRA_FORCE``` | Additional user defined force routines provided. | ```YES```, ```NO``` | all +| ```CHK_CLOSE``` | Check for close encounters. Requires radius of massive bodies to be provided in initial conditions. | ```YES```, ```NO``` | all +| ```INTERACTION_LOOPS``` | Method for checking for interactions between bodies. | ```TRIANGULAR```, ```FLAT```, ```ADAPTIVE``` | all +| ```ENCOUNTER_CHECK``` | Method for checking for close encounters between bodies. | ```TRIANGULAR```, ```SORTSWEEP```, ```ADAPTIVE``` | all +| ```MU2KG``` | Mass units to kilogram conversion factor. | floating point (ex. ```1.988409870698051e+30```) | all +| ```TU2S``` | Time units to seconds conversion factor. | floating point (ex. ```31557600.0```) | all +| ```DU2M``` | Distance units to meters conversion factor. | floating point (ex. ```149597870700.0```) | all +| ```BIG_DISCARD``` | Include data for all fully-interacting bodies (above GMTINY) in each discard. Swifter only. | ```YES```, ```NO``` | all +| ```GR``` | General relativity. | ```YES```, ```NO``` | all +| ```RHILL_PRESENT``` | Hill Radius present in massive body input file. | ```YES```, ```NO``` | SyMBA +| ```ENERGY``` | Track and report the total energy, angular momentum, and mass of the system. | ```YES```, ```NO``` | SyMBA +| ```FRAGMENTATION``` | Resolve collisions with fragmentation. | ```YES```, ```NO``` | SyMBA +| ```ROTATION``` | Rotation of massive bodies. Requires rotation vectors, radii, and moments of inertia to be provided in initial conditions. | ```YES```, ```NO``` | SyMBA +| ```GMTINY``` | Mass cutoff between fully and semi-interacting massive bodies in gravitational mass units. | floating point (ex. ```4e-06```) | SyMBA +| ```MIN_GMFRAG``` | Minimum fragment mass in gravitational mass units. | floating point (ex. ```1e-09```) | SyMBA +| ```TIDES``` | Tidal dissipation model. | ```YES```, ```NO``` | *(under development)* +| ```YORP``` | YORP effect. | ```YES```, ```NO``` | *(under development)* +| ```YARKOVSKY``` | Yarkovsky effect. | ```YES```, ```NO``` | *(under development)* + +In the above list, the following are defined as: +- ```HELIO``` - Use the heliocentric coordinate frame for ```CHK_QMIN``` +- ```BARY``` - Use the barycentric coordinate frame for ```CHK_QMIN``` +- ```XV``` - Heliocentric position and velocity components for ```IN_FORM``` and/or ```OUT_FORM``` +- ```EL``` - Osculating orbital elements for ```IN_FORM``` and/or ```OUT_FORM``` +- ```XVEL``` - Heliocentric position and velocity components and osculating orbital elements for ```OUT_FORM``` +- ```NETCDF_FLOAT``` - Single precision NetCDF format for ```OUT_TYPE``` +- ```NETCDF_DOUBLE``` - Double precision NetCDF format for ```OUT_TYPE``` + +For more details on the ```INTERACTION_LOOPS``` and ```ENCOUNTER_CHECK``` options, see the **Updates to Swifter SyMBA** section below. \ No newline at end of file diff --git a/README_tables/simulation_kwargs.md b/README_tables/simulation_kwargs.md new file mode 100644 index 000000000..02a49af9b --- /dev/null +++ b/README_tables/simulation_kwargs.md @@ -0,0 +1,59 @@ +# swiftest.Simulation(**kwargs) +| Key Word Name | Key Word Description | Options | Compatible Integrators | +|---------------------------------|----------------------------------------------------------------------------------------------------|----------------------------------------------------------------------------------------------------|------------------------| +|```simdir``` | Path to subdirectory in which to store data. Default is ```/simdir```. | pathlike string (ex. ```path/to/directory```) | all +|```read_param``` | Read in a pre-existing parameter input file. Default is ```False```. | ```True```, ```False``` | all +|```param_file``` | Name of the pre-existing parameter input file. Only used if ```read_param``` is set to ```True```. | string (ex. ```param.in```) | all +|```read_old_output``` | Read in a pre-existing simulation output file. Default is ```False```. | ```True```, ```False``` | all +|```codename``` | Name of the N-body code to use. Default is ```Swiftest```. | ```Swiftest```, ```Swifter```, ```Swift``` | all +|```integrator``` | Name of the N-body integrator to use. Default is ```symba```. | ```symba```, ```helio```, ```rmvs```, ```whm``` | all +|```t0``` | The reference time for the start of the simulation in time units. Default is ```0.0```. | floating point (ex. ```0.0```) | all +|```tstart``` | Simulation start time for a restarted run in time units. Default is ```0.0```. | floating point (ex. ```0.0```) | all +|```tstop``` | Simulation end time in time units. Must be greater than ```tstart```. | floating point (ex. ```100.0```) | all +|```dt``` | Simulation step size in time units. Must be less than or equal to ```tstop```-```tstart```. | floating point (ex. ```0.005```) | all +|```istep_out``` | The number of time steps (```dt```) between output saves to memory. Either ```istep_out``` **OR** ```tstep_out``` may be set. Default is ```1```. | integer (ex. ```200```) | all +|```dump_cadence``` | The number of output steps between when data saved to memory is written to file. Setting to ```0``` results in writing data to file only at the completion of the simulation. Default is ```10```. | integer (ex. ```10```) | all +|```tstep_out``` | The approximate time between when outputs saved in memory are written to file in time units. Either ```istep_out``` **OR** ```tstep_out``` may be set. | floating point (ex. ```10.0```) that calculates ```istep_out = floor(tstep_out / dt)``` | all +|```init_cond_file_type``` | Input file format. Default is ```NETCDF_DOUBLE```. | ```NETCDF_DOUBLE```, ```NETCDF_FLOAT```, ```ASCII``` | all +|```init_cond_file_name``` | Input file name(s). If ```init_cond_file_type``` is set to ```NETCDF_DOUBLE``` or ```NETCDF_FLOAT```, default is ```init_cond.nc```. If ```init_cond_file_type``` is set to ```ASCII```, default is a dictionary: ```{"CB" : "cb.in", "PL" : "pl.in", "TP" : "tp.in"}```. | string (ex. ```my_init_cond.nc```) or dictionary ```{"CB" : "mycb.in", "PL" : "mypl.in", "TP" : "mytp.in"}``` | all +|```init_cond_format``` | Input format. Default is ```EL```. | ```EL```, ```XV``` | all +|```output_file_type``` | Output file format. Default is ```NETCDF_DOUBLE```. ```REAL4```, ```REAL8```, ```XDR4```, ```XDR8``` Swifter/Swift only. | ```NETCDF_DOUBLE```, ```NETCDF_FLOAT```, ```REAL4```, ```REAL8```, ```XDR4```, ```XDR8``` | all +|```output_file_name``` | Output file name. Default is ```bin.nc```. | string (ex. ```mydata.nc```) | all +|```output_format``` | Output format. Default is ```XVEL```. | ```XV```, ```XVEL``` | all +|```MU``` | Mass unit system to use in the simulation. Default is ```Msun```. | ```Msun```, ```Mearth```, ```kg```, ```g``` (case-insensitive) | all +|```DU``` | Distance unit system to use in the simulation. Default is ```AU```. | ```AU```, ```Rearth```, ```m```, ```cm``` (case-insensitive) | all +|```TU``` | Time unit system to use in the simulation. Default is ```Y```. | ```Y```, ```YR```, ```DAY``` (Julian day), ```d``` (Julian day), ```JD``` (Julian day), ```s``` (case-insensitive) | all +|```MU2KG``` | Mass units to kilogram conversion factor. Overrides ```MU```. | floating point (ex. ```1.988409870698051e+30```) | all +|```DU2M``` | Distance units to meters conversion factor. Overrides ```DU```. | floating point (ex. ```31557600.0```) | all +|```TU2S``` | Time units to seconds conversion factor. Overrides ```TU```. | floating point (ex. ```149597870700.0```) | all +|```rmin``` | Heliocentric distance at which a test particle is considered merged with the central body in distance units. Default is the radius of the central body in system units. | floating point (ex. ```0.3```) | all +|```rmax``` | Heliocentric distance at which a test particle is too distant from the central body in distance units. Default is ```10000.0 AU```. | floating point (ex. ```10000.0```) | all +|```qmin_coord``` | Coordinate frame used to check for minimum pericenter distance. Default is ```HELIO```. | ```HELIO```, ```BARY``` | all +|```mtiny``` | Mass cutoff between fully and semi-interacting massive bodies in mass units. Either ```mtiny``` **OR** ```gmtiny``` may be set. | floating point (ex. ```1e23```) | all +|```gmtiny``` | Mass cutoff between fully and semi-interacting massive bodies in gravitational mass units. Default is ```0.0```. Either ```mtiny``` **OR** ```gmtiny``` may be set. | floating point (ex. ```4e-6```) | all +|```close_encounter_check``` | Check for close encounters. Default is ```True```. Requires radius of massive bodies to be provided in initial conditions. | ```True```, ```False``` | all +|```general_relativity``` | General relativity. Default is ```True```. | ```True```, ```False``` | all +|```fragmentation``` | Resolve collisions with fragmentation. Default is ```False```. | ```True```, ```False``` | SyMBA +|```minimum_fragment_gmass``` | Minimum fragment mass in gravitational mass units. Default is ```0.0```. Either ```minimum_fragment_gmass``` **OR** ```minimum_fragment_mass``` may be set. | floating point (ex. ```1e-9```) | SyMBA +|```minimum_fragment_mass``` | Minimum fragment mass in mass units. Either ```minimum_fragment_gmass``` **OR** ```minimum_fragment_mass``` may be set. | floating point (ex. ```1e20```) | SyMBA +|```rotation``` | Rotation of massive bodies. Requires rotation vectors, radii, and moments of inertia to be provided in initial conditions. Default is ```False```. | ```True```, ```False``` | SyMBA +|```compute_conservation_values```| Track and report the total energy, angular momentum, and mass of the system. Default is ```False```. | ```True```, ```False``` | SyMBA +|```rhill_present``` | Hill Radius present in massive body input file. Default is ```False```. | ```True```, ```False``` | SyMBA +|```extra_force``` | Additional user defined force routines provided. Default is ```False```. | ```True```, ```False``` | all +|```big_discard``` | Include data for all fully-interacting bodies (above GMTINY) in each discard. Swifter only. Default is ```False```. | ```True```, ```False``` | all +|```restart``` | If ```True```, the simulation given by ```output_file_name``` will be restarted from ```t0```. Default is ```False```. | ```True```, ```False``` | all +|```interaction_loops``` | Method for checking for interactions between bodies. Default is ```TRIANGULAR```. | ```TRIANGULAR```, ```FLAT```, ```ADAPTIVE``` | all +|```encounter_check_loops``` | Method for checking for close encounters between bodies. Default is ```TRIANGULAR```. | ```TRIANGULAR```, ```SORTSWEEP```, ```ADAPTIVE``` | all + +In the above list, the following are defined as: +- ```HELIO``` - Use the heliocentric coordinate frame. +- ```BARY``` - Use the barycentric coordinate frame. +- ```XV``` - Heliocentric position and velocity components. +- ```EL``` - Osculating orbital elements. +- ```XVEL``` - Heliocentric position and velocity components and osculating orbital elements. +- ```NETCDF_FLOAT``` - Single precision NetCDF format. +- ```NETCDF_DOUBLE``` - Double precision NetCDF format. +- ```REAL4``` - Single precision 4-byte native Fortran binary format (Swifter/Swift only) +- ```REAL8``` - Double precision 8-byte native Fortran binary format (Swifter/Swift only) +- ```XDR4``` - Single precision 4-byte XDR format (Swifter/Swift only) +- ```XDR8``` - Double precision 8-byte XDR format (Swifter/Swift only) \ No newline at end of file diff --git a/cmake/Modules/FindMKL.cmake b/cmake/Modules/FindMKL.cmake new file mode 100644 index 000000000..9e48932c3 --- /dev/null +++ b/cmake/Modules/FindMKL.cmake @@ -0,0 +1,17 @@ +# 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/FindOpenMP_Fortran.cmake b/cmake/Modules/FindOpenMP_Fortran.cmake index c8e0ca2b4..32777569e 100644 --- a/cmake/Modules/FindOpenMP_Fortran.cmake +++ b/cmake/Modules/FindOpenMP_Fortran.cmake @@ -26,14 +26,14 @@ INCLUDE (${CMAKE_ROOT}/Modules/FindPackageHandleStandardArgs.cmake) SET (OpenMP_Fortran_FLAG_CANDIDATES - #Microsoft Visual Studio - "/openmp" - #Intel windows - "/Qopenmp" #Intel "-qopenmp" + #Intel windows + "/Qopenmp" #Gnu "-fopenmp" + #Portland Group + "-mp" #Empty, if compiler automatically accepts openmp " " #Sun @@ -42,8 +42,6 @@ SET (OpenMP_Fortran_FLAG_CANDIDATES "+Oopenmp" #IBM XL C/c++ "-qsmp" - #Portland Group - "-mp" ) IF (DEFINED OpenMP_Fortran_FLAGS) diff --git a/cmake/Modules/SetCompileFlag.cmake b/cmake/Modules/SetCompileFlag.cmake index 1d110ae6d..4141c4773 100644 --- a/cmake/Modules/SetCompileFlag.cmake +++ b/cmake/Modules/SetCompileFlag.cmake @@ -23,12 +23,12 @@ # "-Wall" # GNU # "-warn all" # Intel # ) -# The optin "-Wall" will be checked first, and if it works, will be +# The option "-Wall" will be checked first, and if it works, will be # appended to the CMAKE_C_FLAGS variable. If it doesn't work, then # "-warn all" will be tried. If this doesn't work then checking will # terminate because REQUIRED was given. # -# The reasong that the variable must be given twice (first as the name then +# The reasoning that the variable must be given twice (first as the name then # as the value in quotes) is because of the way CMAKE handles the passing # of variables in functions; it is difficult to extract a variable's # contents and assign new values to it from within a function. diff --git a/cmake/Modules/SetFortranFlags.cmake b/cmake/Modules/SetFortranFlags.cmake index e0b21862b..d869e89b6 100644 --- a/cmake/Modules/SetFortranFlags.cmake +++ b/cmake/Modules/SetFortranFlags.cmake @@ -21,32 +21,36 @@ STRING(TOUPPER "${CMAKE_BUILD_TYPE}" BT) IF(BT STREQUAL "RELEASE") SET(CMAKE_BUILD_TYPE RELEASE CACHE STRING - "Choose the type of build, options are DEBUG, RELEASE, or TESTING." + "Choose the type of build, options are DEBUG, RELEASE, PROFILE, or TESTING." FORCE) ELSEIF(BT STREQUAL "DEBUG") SET (CMAKE_BUILD_TYPE DEBUG CACHE STRING - "Choose the type of build, options are DEBUG, RELEASE, or TESTING." + "Choose the type of build, options are DEBUG, RELEASE, PROFILE, or TESTING." FORCE) ELSEIF(BT STREQUAL "TESTING") SET (CMAKE_BUILD_TYPE TESTING CACHE STRING - "Choose the type of build, options are DEBUG, RELEASE, or TESTING." + "Choose the type of build, options are DEBUG, RELEASE, PROFILE, or TESTING." FORCE) +ELSEIF(BT STREQUAL "PROFILE") + SET (CMAKE_BUILD_TYPE PROFILE CACHE STRING + "Choose the type of build, options are DEBUG, RELEASE, PROFILE, or TESTING." + FORCE) ELSEIF(NOT BT) SET(CMAKE_BUILD_TYPE RELEASE CACHE STRING - "Choose the type of build, options are DEBUG, RELEASE, or TESTING." + "Choose the type of build, options are DEBUG, RELEASE, PROFILE, or TESTING." FORCE) MESSAGE(STATUS "CMAKE_BUILD_TYPE not given, defaulting to RELEASE") ELSE() - MESSAGE(FATAL_ERROR "CMAKE_BUILD_TYPE not valid, choices are DEBUG, RELEASE, or TESTING") + MESSAGE(FATAL_ERROR "CMAKE_BUILD_TYPE not valid, choices are DEBUG, RELEASE, PROFILE, or TESTING") ENDIF(BT STREQUAL "RELEASE") ######################################################### # If the compiler flags have already been set, return now ######################################################### -IF(CMAKE_Fortran_FLAGS_RELEASE AND CMAKE_Fortran_FLAGS_TESTING AND CMAKE_Fortran_FLAGS_DEBUG) +IF(CMAKE_Fortran_FLAGS_RELEASE AND CMAKE_Fortran_FLAGS_TESTING AND CMAKE_Fortran_FLAGS_DEBUG AND CMAKE_Fortran_FLAGS_PROFILE) RETURN () -ENDIF(CMAKE_Fortran_FLAGS_RELEASE AND CMAKE_Fortran_FLAGS_TESTING AND CMAKE_Fortran_FLAGS_DEBUG) +ENDIF(CMAKE_Fortran_FLAGS_RELEASE AND CMAKE_Fortran_FLAGS_TESTING AND CMAKE_Fortran_FLAGS_DEBUG AND CMAKE_Fortran_FLAGS_PROFILE) ######################################################################## # Determine the appropriate flags for this compiler for each build type. @@ -81,7 +85,6 @@ SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}" ################### ### DEBUG FLAGS ### ################### - # NOTE: debugging symbols (-g or /debug:full) are already on by default # Disable optimizations @@ -163,7 +166,7 @@ SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG}" # Aligns a variable to a specified boundary and offset SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG}" - Fortran "-align all" # Intel + Fortran "-align all -align array64byte" # Intel ) # Enables changing the variable and array memory layout @@ -215,14 +218,13 @@ SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_TESTING "${CMAKE_Fortran_FLAGS_TESTING}" ##################### ### RELEASE FLAGS ### ##################### - # NOTE: agressive optimizations (-O3) are already turned on by default # Unroll loops SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" - Fortran "-funroll-loops" # GNU - "-unroll" # Intel + Fortran "-unroll" # Intel "/unroll" # Intel Windows + "-funroll-loops" # GNU "-Munroll" # Portland Group ) @@ -234,19 +236,6 @@ SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" "-Minline" # Portland Group ) -# Interprocedural (link-time) optimizations -SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" - Fortran "-ipo" # Intel - "/Qipo" # Intel Windows - "-flto" # GNU - "-Mipa" # Portland Group - ) - -# Single-file optimizations -SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" - Fortran "-ip" # Intel - "/Qip" # Intel Windows - ) # Allows for lines longer than 80 characters without truncation SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" @@ -299,7 +288,34 @@ SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" Fortran "-fma" # Intel ) -# Enables agressive optimixation on floating-points +# Generate fused multiply-add instructions SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" - Fortran "-fp-model=fast" # Intel + Fortran "-qmkl=cluster" # Intel + Fortran "-qmkl" # Intel + Fortran "-mkl" # Old Intel + ) + +##################### +### MATH FLAGS ### +##################### +# Some subroutines require more strict floating point operation optimizations for repeatability +SET_COMPILE_FLAG(STRICTMATH_FLAGS "${STRICTMATH_FLAGS}" + Fortran "-fp-model=precise -prec-div -prec-sqrt -assume protect-parens" # Intel + "/fp:precise /Qprec-div /Qprec-sqrt /assume:protect-parens" # Intel Windows + ) + +# Most subroutines can use aggressive optimization of floating point operations without problems. +SET_COMPILE_FLAG(FASTMATH_FLAGS "${FASTMATH_FLAGS}" + Fortran "-fp-model=fast" + "/fp:fast" + ) + +##################### +### PROFILE FLAGS ### +##################### +# Enables the optimization reports to be generated +SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_PROFILE "${CMAKE_Fortran_FLAGS_RELEASE}" + Fortran "-pg -qopt-report=5 -traceback -p -g3" # Intel + "/Qopt-report:5 /traceback -g3" # Windows Intel + "-pg -fbacktrace" ) diff --git a/cmake/Modules/SetMKL.cmake b/cmake/Modules/SetMKL.cmake new file mode 100644 index 000000000..e58c9f51a --- /dev/null +++ b/cmake/Modules/SetMKL.cmake @@ -0,0 +1,14 @@ +# 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/SetParallelizationLibrary.cmake b/cmake/Modules/SetParallelizationLibrary.cmake index 03ab970e6..224806406 100644 --- a/cmake/Modules/SetParallelizationLibrary.cmake +++ b/cmake/Modules/SetParallelizationLibrary.cmake @@ -12,9 +12,7 @@ # When one is turned on, the other is turned off # If both are off, we explicitly disable them just in case -IF (USE_OPENMP AND USE_MPI) - MESSAGE (FATAL_ERROR "Cannot use both OpenMP and MPI") -ELSEIF (USE_OPENMP) +IF (USE_OPENMP) # Find OpenMP IF (NOT OpenMP_Fortran_FLAGS) FIND_PACKAGE (OpenMP_Fortran) @@ -23,20 +21,16 @@ ELSEIF (USE_OPENMP) ENDIF (NOT OpenMP_Fortran_FLAGS) ENDIF (NOT OpenMP_Fortran_FLAGS) # Turn of MPI - UNSET (MPI_FOUND CACHE) - UNSET (MPI_COMPILER CACHE) - UNSET (MPI_LIBRARY CACHE) -ELSEIF (USE_MPI) +ENDIF (USE_OPENMP) + +IF (USE_MPI) # Find MPI IF (NOT MPI_Fortran_FOUND) FIND_PACKAGE (MPI REQUIRED) ENDIF (NOT MPI_Fortran_FOUND) - # Turn off OpenMP - SET (OMP_NUM_PROCS 0 CACHE - STRING "Number of processors OpenMP may use" FORCE) - UNSET (OpenMP_C_FLAGS CACHE) - UNSET (GOMP_Fortran_LINK_FLAGS CACHE) -ELSE () +ENDIF (USE_MPI) + +IF (NOT USE_OPENMP AND NOT USE_MPI) # Turn off both OpenMP and MPI SET (OMP_NUM_PROCS 0 CACHE STRING "Number of processors OpenMP may use" FORCE) @@ -45,4 +39,4 @@ ELSE () UNSET (MPI_FOUND CACHE) UNSET (MPI_COMPILER CACHE) UNSET (MPI_LIBRARY CACHE) -ENDIF (USE_OPENMP AND USE_MPI) +ENDIF (NOT USE_OPENMP AND NOT USE_MPI) diff --git a/examples/.gitignore b/examples/.gitignore new file mode 100644 index 000000000..ad990dfcb --- /dev/null +++ b/examples/.gitignore @@ -0,0 +1,6 @@ +* +!.gitignore +!Basic_Simulation +!Fragmentation +!helio_gr_test +!whm_gr_test \ No newline at end of file diff --git a/examples/Basic_Simulation/.gitignore b/examples/Basic_Simulation/.gitignore new file mode 100644 index 000000000..0a4af3872 --- /dev/null +++ b/examples/Basic_Simulation/.gitignore @@ -0,0 +1,6 @@ +* +!.gitignore +!initial_conditions.py +!output_reader.py +!run_from_file.py +!read_old_run.py diff --git a/examples/Basic_Simulation/cb.in b/examples/Basic_Simulation/cb.in deleted file mode 100644 index 29c8a7fca..000000000 --- a/examples/Basic_Simulation/cb.in +++ /dev/null @@ -1,16 +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. - -Sun -39.476926408897626 -0.004650467260962157 -4.7535806948127355e-12 --2.2473967953572827e-18 -0.0 0.0 0.07 -11.209306302144773 -38.759372036774764 82.25088158389266 diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index 640330f1f..693e61f33 100644 --- a/examples/Basic_Simulation/initial_conditions.py +++ b/examples/Basic_Simulation/initial_conditions.py @@ -11,107 +11,60 @@ #!/usr/bin/env python3 """ -Generates a set of Swiftest input files from initial conditions. +Generates and runs a set of Swiftest input files from initial conditions with the SyMBA integrator. All simulation +outputs are stored in the /simdata subdirectory. -Returns -------- -param.in : ASCII text file - Swiftest parameter input file. -pl.in : ASCII text file - Swiftest massive body input file. -tp.in : ASCII text file - Swiftest test particle input file. -cb.in : ASCII text file - Swiftest central body input file. +Input +------ +None. + +Output +------ +data.nc : A NetCDF file containing the simulation output. +dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. +dump_param2.in : An ASCII file containing the necessary parameters to restart a simulation. +fraggle.log : An ASCII file containing the information of any collisional events that occured. +init_cond.nc : A NetCDF file containing the initial conditions for the simulation. +param.in : An ASCII file containing the parameters for the simulation. +swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. """ import swiftest import numpy as np from numpy.random import default_rng -# Initialize the simulation object as a variable +# 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() -# Add parameter attributes to the simulation object -sim.param['T0'] = 0.0 -sim.param['TSTOP'] = 10 -sim.param['DT'] = 0.005 -sim.param['ISTEP_OUT'] = 200 -sim.param['ISTEP_DUMP'] = 200 -sim.param['OUT_FORM'] = 'XVEL' -sim.param['OUT_TYPE'] = 'NETCDF_DOUBLE' -sim.param['OUT_STAT'] = 'REPLACE' -sim.param['IN_FORM'] = 'EL' -sim.param['IN_TYPE'] = 'ASCII' -sim.param['PL_IN'] = 'pl.in' -sim.param['TP_IN'] = 'tp.in' -sim.param['CB_IN'] = 'cb.in' -sim.param['BIN_OUT'] = 'out.nc' -sim.param['CHK_QMIN'] = swiftest.RSun / swiftest.AU2M -sim.param['CHK_RMIN'] = swiftest.RSun / swiftest.AU2M -sim.param['CHK_RMAX'] = 1000.0 -sim.param['CHK_EJECT'] = 1000.0 -sim.param['CHK_QMIN_COORD'] = 'HELIO' -sim.param['CHK_QMIN_RANGE'] = f'{swiftest.RSun / swiftest.AU2M} 1000.0' -sim.param['MU2KG'] = swiftest.MSun -sim.param['TU2S'] = swiftest.YR2S -sim.param['DU2M'] = swiftest.AU2M -sim.param['EXTRA_FORCE'] = 'NO' -sim.param['BIG_DISCARD'] = 'NO' -sim.param['CHK_CLOSE'] = 'YES' -sim.param['GR'] = 'YES' -sim.param['INTERACTION_LOOPS'] = 'ADAPTIVE' -sim.param['ENCOUNTER_CHECK'] = 'ADAPTIVE' -sim.param['RHILL_PRESENT'] = 'YES' -sim.param['FRAGMENTATION'] = 'YES' -sim.param['ROTATION'] = 'YES' -sim.param['ENERGY'] = 'YES' -sim.param['GMTINY'] = 1e-6 -sim.param['MIN_GMFRAG'] = 1e-9 - -# Set gravitational units of the system -GU = swiftest.GC / (sim.param['DU2M'] ** 3 / (sim.param['MU2KG'] * sim.param['TU2S'] ** 2)) - -# Add the modern planets and the Sun using the JPL Horizons Database -sim.add("Sun", idval=0, date="2022-08-08") -sim.add("Mercury", idval=1, date="2022-08-08") -sim.add("Venus", idval=2, date="2022-08-08") -sim.add("Earth", idval=3, date="2022-08-08") -sim.add("Mars", idval=4, date="2022-08-08") -sim.add("Jupiter", idval=5, date="2022-08-08") -sim.add("Saturn", idval=6, date="2022-08-08") -sim.add("Uranus", idval=7, date="2022-08-08") -sim.add("Neptune", idval=8, date="2022-08-08") +# 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","Pluto"]) -# Add 5 user-defined massive bodies +# Add 5 user-defined massive bodies. npl = 5 density_pl = 3000.0 / (sim.param['MU2KG'] / sim.param['DU2M'] ** 3) -id_pl = np.array([9, 10, 11, 12, 13]) -name_pl = np.array(["MassiveBody_01", "MassiveBody_02", "MassiveBody_03", "MassiveBody_04", "MassiveBody_05"]) +name_pl = ["MassiveBody_01", "MassiveBody_02", "MassiveBody_03", "MassiveBody_04", "MassiveBody_05"] a_pl = default_rng().uniform(0.3, 1.5, npl) e_pl = default_rng().uniform(0.0, 0.3, npl) inc_pl = default_rng().uniform(0.0, 90, npl) capom_pl = default_rng().uniform(0.0, 360.0, npl) omega_pl = default_rng().uniform(0.0, 360.0, npl) capm_pl = default_rng().uniform(0.0, 360.0, npl) -GM_pl = (np.array([6e23, 8e23, 1e24, 3e24, 5e24]) / sim.param['MU2KG']) * GU -R_pl = np.full(npl, (3 * (GM_pl / GU) / (4 * np.pi * density_pl)) ** (1.0 / 3.0)) -Rh_pl = a_pl * ((GM_pl) / (3 * GU)) ** (1.0 / 3.0) -Ip1_pl = np.array([0.4, 0.4, 0.4, 0.4, 0.4]) -Ip2_pl = np.array([0.4, 0.4, 0.4, 0.4, 0.4]) -Ip3_pl = np.array([0.4, 0.4, 0.4, 0.4, 0.4]) -rotx_pl = np.array([0.0, 0.0, 0.0, 0.0, 0.0]) -roty_pl = np.array([0.0, 0.0, 0.0, 0.0, 0.0]) -rotz_pl = np.array([0.0, 0.0, 0.0, 0.0, 0.0]) +GM_pl = (np.array([6e23, 8e23, 1e24, 3e24, 5e24]) / sim.param['MU2KG']) * sim.GU +R_pl = np.full(npl, (3 * (GM_pl / sim.GU) / (4 * np.pi * density_pl)) ** (1.0 / 3.0)) +Rh_pl = a_pl * ((GM_pl) / (3 * sim.GU)) ** (1.0 / 3.0) +Ip_pl = np.full((npl,3),0.4,) +rot_pl = np.zeros((npl,3)) -sim.addp(id_pl, name_pl, a_pl, e_pl, inc_pl, capom_pl, omega_pl, capm_pl, GMpl=GM_pl, Rpl=R_pl, rhill=Rh_pl, Ip1=Ip1_pl, Ip2=Ip2_pl, Ip3=Ip3_pl, rotx=rotx_pl, roty=roty_pl, rotz=rotz_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, Gmass=GM_pl, radius=R_pl, rhill=Rh_pl, Ip=Ip_pl, rot=rot_pl) -# Add 10 user-defined test particles +# Add 10 user-defined test particles. ntp = 10 -id_tp = np.array([14, 15, 16, 17, 18, 19, 20, 21, 22, 23]) -name_tp = np.array(["TestParticle_01", "TestParticle_02", "TestParticle_03", "TestParticle_04", "TestParticle_05", "TestParticle_06", "TestParticle_07", "TestParticle_08", "TestParticle_09", "TestParticle_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 = default_rng().uniform(0.3, 1.5, ntp) e_tp = default_rng().uniform(0.0, 0.3, ntp) inc_tp = default_rng().uniform(0.0, 90, ntp) @@ -119,7 +72,10 @@ omega_tp = default_rng().uniform(0.0, 360.0, ntp) capm_tp = default_rng().uniform(0.0, 360.0, ntp) -sim.addp(id_tp, name_tp, a_tp, e_tp, inc_tp, capom_tp, omega_tp, capm_tp) +sim.add_body(name=name_tp, a=a_tp, e=e_tp, inc=inc_tp, capom=capom_tp, omega=omega_tp, capm=capm_tp) +# Display the run configuration parameters. +sim.write_param() +sim.get_parameter() -# Save everything to a set of initial conditions files -sim.save('param.in') +# Run the simulation. Arguments may be defined here or thorugh the swiftest.Simulation() method. +sim.run(tstart=0.0, tstop=1.0e3, dt=0.01, istep_out=100, dump_cadence=10) diff --git a/examples/Basic_Simulation/output_reader.py b/examples/Basic_Simulation/output_reader.py index 539038291..977c2a393 100644 --- a/examples/Basic_Simulation/output_reader.py +++ b/examples/Basic_Simulation/output_reader.py @@ -14,33 +14,32 @@ Reads and processes a Swiftest output file. Input -------- -out.nc : NetCDF file - Swiftest output file. +------ +data.nc : A NetCDF file containing the simulation output. -Returns -------- -output.eps : Encapsulated PostScript file. - A figure containing the eccentricity vs. semi-major axis for all bodies at the start of the simulation. +Output +------ +output.eps : Encapsulated PostScript file depicting the eccentricity vs. semi-major axis for all bodies at the start + of the simulation. """ import swiftest import xarray as xr import matplotlib.pyplot as plt -# Read in the simulation output and store it as an Xarray dataset -ds = swiftest.Simulation(param_file="param.in").ds +# Read in the simulation output and store it as an Xarray dataset. +sim = swiftest.Simulation(read_old_output=True) -# Plot of the data and save the output plot -colors = ['white' if x == 'Massive Body' else 'black' for x in ds['particle_type']] -sizes = [100 if x == 'Massive Body' else 10 for x in ds['particle_type']] +# Plot of the data and save the output plot. +colors = ['white' if x == 'Massive Body' else 'black' for x in sim.data['particle_type']] +sizes = [100 if x == 'Massive Body' else 10 for x in sim.data['particle_type']] fig, ax = plt.subplots(nrows=1, ncols=1, figsize=(5,3)) -ax.set(xlabel="Semimajor Axis (AU)", ylabel="Eccentricity", title="Simulation Start") -ax.scatter(ds['a'].isel(time=0), ds['e'].isel(time=0), c=colors, s=sizes, edgecolor='black') +ax.set(xlabel="Semimajor Axis (AU)", ylabel="Eccentricity", title="Simulation Initial Conditions (t=0)") +ax.scatter(sim.data['a'].isel(time=0), sim.data['e'].isel(time=0), c=colors, s=sizes, edgecolor='black') ax.set_xlim(0, 2.0) ax.set_ylim(0, 0.4) -ax.text(1.5, 0.35, f"t = {ds['time'].isel(time=0).values} years", size=10, ha="left") +ax.text(1.5, 0.35, f"t = {sim.data['time'].isel(time=0).values} years", size=10, ha="left") plt.tight_layout() plt.show() -fig.savefig("output.eps", dpi=300, facecolor='white', transparent=False, bbox_inches="tight") \ No newline at end of file +fig.savefig("output.eps", dpi=300, facecolor='white', transparent=False, bbox_inches="tight") diff --git a/examples/Basic_Simulation/param.in b/examples/Basic_Simulation/param.in deleted file mode 100644 index bec3573de..000000000 --- a/examples/Basic_Simulation/param.in +++ /dev/null @@ -1,46 +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. - -! VERSION Swiftest parameter input -T0 0.0 -TSTOP 10 -DT 0.005 -ISTEP_OUT 200 -ISTEP_DUMP 200 -OUT_FORM XVEL -OUT_TYPE NETCDF_DOUBLE -OUT_STAT REPLACE -IN_TYPE ASCII -PL_IN pl.in -TP_IN tp.in -CB_IN cb.in -BIN_OUT out.nc -CHK_QMIN 0.004650467260962157 -CHK_RMIN 0.004650467260962157 -CHK_RMAX 1000.0 -CHK_EJECT 1000.0 -CHK_QMIN_COORD HELIO -CHK_QMIN_RANGE 0.004650467260962157 1000.0 -MU2KG 1.988409870698051e+30 -TU2S 31557600.0 -DU2M 149597870700.0 -IN_FORM EL -EXTRA_FORCE NO -BIG_DISCARD NO -CHK_CLOSE YES -RHILL_PRESENT YES -FRAGMENTATION YES -ROTATION YES -TIDES NO -ENERGY YES -GR YES -INTERACTION_LOOPS ADAPTIVE -ENCOUNTER_CHECK ADAPTIVE -GMTINY 1e-06 -MIN_GMFRAG 1e-09 diff --git a/examples/Basic_Simulation/pl.in b/examples/Basic_Simulation/pl.in deleted file mode 100644 index 3f18aca0e..000000000 --- a/examples/Basic_Simulation/pl.in +++ /dev/null @@ -1,88 +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. - -13 -Mercury 6.553709809565314146e-06 0.0014751262621647182575 -1.6306381826061645943e-05 -0.38709864823618972407 0.20562513690973019398 7.0036250456070128223 -48.30204974520415817 29.18823342267911869 114.9720047697775982 -0.0 0.0 0.34599999999999997424 -3.5734889863322150192 -18.38008501876561206 34.361513668512199956 -Venus 9.6633133995815381836e-05 0.006759085242739840662 -4.0453784346544178454e-05 -0.72332603580811538624 0.0067486079191121668003 3.394406261149808035 -76.61738837179606776 54.777760273590551776 315.37095689555837907 -0.0 0.0 0.4000000000000000222 -0.17650282045605921225 -3.6612475825356215592 8.702866268072763821 -Earth 0.000120026935827952456416 0.010044668314295209318 -4.25875607065040958e-05 -0.9999943732711822353 0.016707309394717231171 0.0028984767436730000077 -174.05498211951208987 289.04709044403989537 213.07530468023790604 -0.0 0.0 0.33069999999999999396 -5.002093202481912218 0.055213529850334066125 2301.2110537292529557 -Mars 1.2739802010675941808e-05 0.007246950762048707243 -2.265740805092889601e-05 -1.5237812078483019551 0.0935087708803710449 1.8479353068000929916 -49.489305419773351957 286.70300191753761965 24.878418068365981242 -0.0 0.0 0.3644000000000000017 -997.9357048213454125 -909.4072592492943007 1783.4501726537997323 -Jupiter 0.03769225108898567778 0.3552222491747608486 -0.00046732617030490929307 -5.2028063728088866924 0.048395118271449058533 1.3035670146561249005 -100.516498130230701236 273.44233262595901124 346.26538105843917492 -0.0 0.0 0.27560000000000001164 --80.96619889339111482 -2388.0060524649362916 5008.7314931237953832 -Saturn 0.01128589982009127331 0.43757948578866074266 -0.00038925687730393611812 -9.580020069168169172 0.053193613750490406633 2.4864365613724639381 -113.597044717589099605 335.10179422401358806 237.66485199561481068 -0.0 0.0 0.22000000000000000111 -441.93538182505989814 378.5284220382117538 5135.9110455622733884 -Uranus 0.001723658947826773068 0.4705353566089944894 -0.00016953449859497231466 -19.272143108769419939 0.043779687288749750962 0.7707536154556786645 -74.077748995180698444 93.42271392662131291 242.37685081109759722 -0.0 0.0 0.23000000000000000999 --677.3000258209181323 -3008.109907190578637 -836.301326618569835 -Neptune 0.0020336100526728302882 0.78184929587893868845 -0.000164587904124493665 -30.305539399096510067 0.014544938874222059638 1.7686697746048700708 -131.73604731224671127 249.9779420269553043 332.54824537252648042 -0.0 0.0 0.23000000000000000999 -1231.1804455066093229 -2178.0887091151860042 2329.6411363603121418 -MassiveBody_01 1.1912109366578087428e-05 0.0016092923734511708263 -2.425055692051244981e-05 -0.3460404950890429432 0.2093906512182220625 0.11109012870384793459 -114.31328763688792094 347.82259114762894114 96.0534391561842682 -0.4000000000000000222 0.4000000000000000222 0.4000000000000000222 -0.0 0.0 0.0 -MassiveBody_02 1.5882812488770779849e-05 0.0016802531895603555184 -2.6691191565570073646e-05 -0.32826188156947710972 0.27866488696288682636 77.21223337306255985 -251.99014895640269174 53.772702227560969845 165.6085387284213084 -0.4000000000000000222 0.4000000000000000222 0.4000000000000000222 -0.0 0.0 0.0 -MassiveBody_03 1.9853515610963475658e-05 0.004324919007577881884 -2.8752214513575297366e-05 -0.7843689028022314824 0.06176128116947356833 78.74144231136708072 -286.63765100951468412 347.55933571120488068 266.36960496595537506 -0.4000000000000000222 0.4000000000000000222 0.4000000000000000222 -0.0 0.0 0.0 -MassiveBody_04 5.9560546832890430362e-05 0.0056765613035874530265 -4.146786902759040254e-05 -0.7138176832994267418 0.28016098557400787028 22.725690778108500467 -203.41845532080247949 219.74297850728484605 14.730732982803269593 -0.4000000000000000222 0.4000000000000000222 0.4000000000000000222 -0.0 0.0 0.0 -MassiveBody_05 9.9267578054817388455e-05 0.010382929139161686458 -4.916559523190238318e-05 -1.101215402063684401 0.076651567404004070094 52.41961577462824806 -142.90070862650665617 293.70542448390904156 318.5666754758643151 -0.4000000000000000222 0.4000000000000000222 0.4000000000000000222 -0.0 0.0 0.0 diff --git a/examples/Basic_Simulation/tp.in b/examples/Basic_Simulation/tp.in deleted file mode 100644 index 162f8c0af..000000000 --- a/examples/Basic_Simulation/tp.in +++ /dev/null @@ -1,40 +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. - -10 -TestParticle_01 -1.0288790290699558749 0.088535376967516773994 39.679062610233010844 -51.107327480220099858 20.90477961082723013 183.92936958121950397 -TestParticle_02 -0.54831541717225318333 0.20048853000030755767 32.784952066779297297 -66.59436607119042151 196.2609764918545352 76.40623742948525887 -TestParticle_03 -0.9815578696795972391 0.25717438840188583393 38.959194313128776344 -158.31201212846775661 93.86793546512863884 126.96040079919036714 -TestParticle_04 -0.70510786000431613374 0.068740260615181125736 39.981235917453354034 -26.668314027440779057 12.507089902982141183 53.606668142734086757 -TestParticle_05 -1.336737159289705712 0.25044351028750111432 74.189544264066626056 -313.1647935522670423 152.39951433565357775 322.52271715518395467 -TestParticle_06 -0.64018428687513928566 0.1478972702874425671 73.39555666508663023 -74.03379498826825511 124.22185942531125136 106.36095293685497154 -TestParticle_07 -1.2738161048947760356 0.17129911220230967239 78.723790909435408025 -111.971184037421835455 315.6294407604535195 108.74538288631850946 -TestParticle_08 -0.5196197141250760154 0.26607581023277782073 79.221465395061358095 -240.07768052067768849 177.4793327047061382 189.85775920180086018 -TestParticle_09 -0.7160151851892424535 0.29584187625470087513 58.1214116614385361 -24.22606869850931588 338.4678256522021229 136.32070882113120547 -TestParticle_10 -1.0782431797945351004 0.11096856177737297877 54.729767236739554903 -280.85362091874827684 116.780853088052467115 286.99855363222661708 diff --git a/examples/Fragmentation/.gitignore b/examples/Fragmentation/.gitignore new file mode 100644 index 000000000..ff09bd225 --- /dev/null +++ b/examples/Fragmentation/.gitignore @@ -0,0 +1,3 @@ +* +!.gitignore +!Fragmentation_Movie.py diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 3c23a510a..fafe319f8 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -23,70 +23,221 @@ Returns ------- fragmentation.mp4 : mp4 movie file - Movide of a fragmentation event. + Movie of a fragmentation event. """ import swiftest import numpy as np +import xarray as xr import matplotlib.pyplot as plt import matplotlib.animation as animation -from matplotlib.animation import FuncAnimation - -# Change this to be the parameter input file correlated with the run that you -# wish to test. Swiftest will pull in the corresponding out.nc file automatically. -param_file = "param.hitandrun.in" - -# Change this to an appropriate title and filename to appear on the movie. -movie_title = "Hit and Run" -movie_filename = "hitandrun.mp4" - -# Pull in the Swiftest output data from the parameter file and store it as a Xarray dataset. -ds = swiftest.Simulation(param_file=param_file).ds - -# Calculate the number of frames in the dataset. -nframes = int(ds['time'].size) - -# Define a function to calculate the center of mass of the system. -def center(xhx, xhy, xhz, Gmass): - x_com = np.sum(Gmass * xhx) / np.sum(Gmass) - y_com = np.sum(Gmass * xhy) / np.sum(Gmass) - z_com = np.sum(Gmass * xhz) / np.sum(Gmass) - return x_com, y_com, z_com - -# Calculate the distance along the y-axis between the colliding bodies at the start of the simulation. -# This will be used to scale the axis limits on the movie. -scale_frame = abs(ds['xhy'].isel(time=0).isel(id=1).values) + abs(ds['xhy'].isel(time=0).isel(id=2).values) - -# Set up the figure and the animation. -fig, ax = plt.subplots(figsize=(4,4)) -def animate(i): - # Calculate the position and mass of all bodies in the system at time i and store as a numpy array. - xhx = ds['xhx'].isel(time=i).dropna(dim='id').values - xhy = ds['xhy'].isel(time=i).dropna(dim='id').values - xhz = ds['xhx'].isel(time=i).dropna(dim='id').values - Gmass = ds['Gmass'].isel(time=i).dropna(dim='id').values[1:] # Drop the Sun from the numpy array. - - # Calculate the center of mass of the system at time i. While the center of mass relative to the - # colliding bodies does not change, the center of mass of the collision will move as the bodies - # orbit the system center of mass. - x_com, y_com, z_com = center(xhx, xhy, xhz, Gmass) - - # Create the figure and plot the bodies as points. - fig.clear() - ax = fig.add_subplot(111) - ax.set_title(movie_title) - ax.set_xlabel("xhx") - ax.set_ylabel("xhy") - ax.set_xlim(x_com - scale_frame, x_com + scale_frame) - ax.set_ylim(y_com - scale_frame, y_com + scale_frame) - ax.grid(False) - ax.set_xticks([]) - ax.set_yticks([]) - - ax.scatter(xhx, xhy, s = (5000000000 * Gmass)) - - plt.tight_layout() - -# Generate the movie. -ani = animation.FuncAnimation(fig, animate, interval=1, frames=nframes, repeat=False) -ani.save(movie_filename, fps=60, dpi=300, extra_args=['-vcodec', 'libx264']) \ No newline at end of file +from pathlib import Path + +# ---------------------------------------------------------------------------------------------------------------------- +# Define the names and initial conditions of the various fragmentation simulation types +# ---------------------------------------------------------------------------------------------------------------------- +available_movie_styles = ["disruption_headon", "disruption_off_axis", "supercatastrophic_headon", "supercatastrophic_off_axis","hitandrun_disrupt", "hitandrun_pure"] +movie_title_list = ["Head-on Disruption", "Off-axis Disruption", "Head-on Supercatastrophic", "Off-axis Supercatastrophic", "Hit and Run w/ Runner Disruption", "Pure Hit and Run"] +movie_titles = dict(zip(available_movie_styles, movie_title_list)) +num_movie_frames = 1200 + +# These initial conditions were generated by trial and error +names = ["Target","Projectile"] +pos_vectors = {"disruption_headon" : [np.array([1.0, -5.0e-05, 0.0]), + np.array([1.0, 5.0e-05 ,0.0])], + "disruption_off_axis" : [np.array([1.0, -5.0e-05, 0.0]), + np.array([1.0, 5.0e-05 ,0.0])], + "supercatastrophic_headon": [np.array([1.0, -5.0e-05, 0.0]), + np.array([1.0, 5.0e-05, 0.0])], + "supercatastrophic_off_axis": [np.array([1.0, -5.0e-05, 0.0]), + np.array([1.0, 5.0e-05, 0.0])], + "hitandrun_disrupt" : [np.array([1.0, -4.2e-05, 0.0]), + np.array([1.0, 4.2e-05, 0.0])], + "hitandrun_pure" : [np.array([1.0, -4.2e-05, 0.0]), + np.array([1.0, 4.2e-05, 0.0])] + } + +vel_vectors = {"disruption_headon" : [np.array([ 0.00, 6.280005, 0.0]), + np.array([ 0.00, -6.280005, 0.0])], + "disruption_off_axis" : [np.array([ 0.00, 6.280005, 0.0]), + np.array([ 0.50, -6.280005, 0.0])], + "supercatastrophic_headon": [np.array([ 0.00, 6.28, 0.0]), + np.array([ 0.00, -6.28, 0.0])], + "supercatastrophic_off_axis": [np.array([ 0.00, 6.28, 0.0]), + np.array([ 0.50, -6.28, 0.0])], + "hitandrun_disrupt" : [np.array([ 0.00, 6.28, 0.0]), + np.array([-1.45, -6.28, 0.0])], + "hitandrun_pure" : [np.array([ 0.00, 6.28, 0.0]), + np.array([-1.51, -6.28, 0.0])] + } + +rot_vectors = {"disruption_headon" : [np.array([0.0, 0.0, 0.0]), + np.array([0.0, 0.0, 0.0])], + "disruption_off_axis": [np.array([0.0, 0.0, -6.0e4]), + np.array([0.0, 0.0, 1.0e5])], + "supercatastrophic_headon": [np.array([0.0, 0.0, 0.0]), + np.array([0.0, 0.0, 0.0])], + "supercatastrophic_off_axis": [np.array([0.0, 0.0, -6.0e4]), + np.array([0.0, 0.0, 1.0e5])], + "hitandrun_disrupt" : [np.array([0.0, 0.0, 6.0e4]), + np.array([0.0, 0.0, 1.0e5])], + "hitandrun_pure" : [np.array([0.0, 0.0, 6.0e4]), + np.array([0.0, 0.0, 1.0e5])] + } + +body_Gmass = {"disruption_headon" : [1e-7, 1e-10], + "disruption_off_axis" : [1e-7, 1e-10], + "supercatastrophic_headon" : [1e-7, 1e-8], + "supercatastrophic_off_axis": [1e-7, 1e-8], + "hitandrun_disrupt" : [1e-7, 7e-10], + "hitandrun_pure" : [1e-7, 7e-10] + } + +density = 3000 * swiftest.AU2M**3 / swiftest.MSun +GU = swiftest.GMSun * swiftest.YR2S**2 / swiftest.AU2M**3 +body_radius = body_Gmass.copy() +for k,v in body_Gmass.items(): + body_radius[k] = [((Gmass/GU)/(4./3.*np.pi*density))**(1./3.) for Gmass in v] + +body_radius["hitandrun_disrupt"] = [7e-6, 3.25e-6] +body_radius["hitandrun_pure"] = [7e-6, 3.25e-6] + +# ---------------------------------------------------------------------------------------------------------------------- +# Define the animation class that will generate the movies of the fragmentation outcomes +# ---------------------------------------------------------------------------------------------------------------------- + + +def encounter_combiner(sim): + """ + Combines simulation data with encounter data to produce a dataset that contains the position, + mass, radius, etc. of both. It will interpolate over empty time values to fill in gaps. + """ + + # Only keep a minimal subset of necessary data from the simulation and encounter datasets + keep_vars = ['rh','Gmass','radius'] + data = sim.data[keep_vars] + enc = sim.encounters[keep_vars].load() + + # Remove any encounter data at the same time steps that appear in the data to prevent duplicates + t_not_duplicate = ~enc['time'].isin(data['time']) + enc = enc.where(t_not_duplicate,drop=True) + tgood=enc.time.where(~np.isnan(enc.time),drop=True) + enc = enc.sel(time=tgood) + + # The following will combine the two datasets along the time dimension, sort the time dimension, and then fill in any time gaps with interpolation + ds = xr.combine_nested([data,enc],concat_dim='time').sortby("time").interpolate_na(dim="time") + + # Interpolate in time to make a smooth, constant time step dataset + smooth_time = np.linspace(start=tgood.isel(time=0), stop=ds.time[-1], num=num_movie_frames) + ds = ds.interp(time=smooth_time) + + return ds + +class AnimatedScatter(object): + """An animated scatter plot using matplotlib.animations.FuncAnimation.""" + + def __init__(self, sim, animfile, title, style, nskip=1): + + self.ds = encounter_combiner(sim) + nframes = int(self.ds['time'].size) + self.sim = sim + self.title = title + self.body_color_list = {'Initial conditions': 'xkcd:windows blue', + 'Disruption': 'xkcd:baby poop', + 'Supercatastrophic': 'xkcd:shocking pink', + 'Hit and run fragmention': 'xkcd:blue with a hint of purple', + 'Central body': 'xkcd:almost black'} + + # Set up the figure and axes... + self.figsize = (4,4) + self.fig, self.ax = self.setup_plot() + + # Then setup FuncAnimation. + self.ani = animation.FuncAnimation(self.fig, self.update_plot, interval=1, frames=range(0,nframes,nskip), blit=True) + self.ani.save(animfile, fps=60, dpi=300, extra_args=['-vcodec', 'libx264']) + print(f"Finished writing {animfile}") + + def setup_plot(self): + fig = plt.figure(figsize=self.figsize, dpi=300) + plt.tight_layout(pad=0) + + # Calculate the distance along the y-axis between the colliding bodies at the start of the simulation. + # This will be used to scale the axis limits on the movie. + rhy1 = self.ds['rh'].sel(name="Target",space='y').isel(time=0).values[()] + rhy2 = self.ds['rh'].sel(name="Projectile",space='y').isel(time=0).values[()] + + scale_frame = abs(rhy1) + abs(rhy2) + ax = plt.Axes(fig, [0.1, 0.1, 0.8, 0.8]) + self.ax_pt_size = self.figsize[0] * 0.7 * 72 / scale_frame + ax.set_xlim(-scale_frame, scale_frame) + ax.set_ylim(-scale_frame, scale_frame) + ax.set_xticks([]) + ax.set_yticks([]) + ax.set_xlabel("x") + ax.set_ylabel("y") + ax.set_title(self.title) + fig.add_axes(ax) + + self.scatter_artist = ax.scatter([], [], animated=True, c='k', edgecolors='face') + return fig, ax + + def update_plot(self, frame): + # Define a function to calculate the center of mass of the system. + def center(Gmass, x, y): + x = x[~np.isnan(x)] + y = y[~np.isnan(y)] + Gmass = Gmass[~np.isnan(Gmass)] + x_com = np.sum(Gmass * x) / np.sum(Gmass) + y_com = np.sum(Gmass * y) / np.sum(Gmass) + return x_com, y_com + + Gmass, rh, point_rad = next(self.data_stream(frame)) + x_com, y_com = center(Gmass, rh[:,0], rh[:,1]) + self.scatter_artist.set_offsets(np.c_[rh[:,0] - x_com, rh[:,1] - y_com]) + self.scatter_artist.set_sizes(point_rad**2) + return self.scatter_artist, + + def data_stream(self, frame=0): + while True: + ds = self.ds.isel(time=frame) + ds = ds.where(ds['name'] != "Sun", drop=True) + radius = ds['radius'].values + Gmass = ds['Gmass'].values + rh = ds['rh'].values + point_rad = radius * self.ax_pt_size + yield Gmass, rh, point_rad + +if __name__ == "__main__": + + print("Select a fragmentation movie to generate.") + print("1. Head-on disruption") + print("2. Off-axis disruption") + print("3. Head-on supercatastrophic") + print("4. Off-axis supercatastrophic") + print("5. Hit and run with disruption of the runner") + print("6. Pure hit and run") + print("7. All of the above") + user_selection = int(input("? ")) + + if user_selection > 0 and user_selection < 7: + movie_styles = [available_movie_styles[user_selection-1]] + else: + print("Generating all movie styles") + movie_styles = available_movie_styles.copy() + + for style in movie_styles: + print(f"Generating {movie_titles[style]}") + movie_filename = f"{style}.mp4" + # Pull in the Swiftest output data from the parameter file and store it as a Xarray dataset. + sim = swiftest.Simulation(simdir=style, rotation=True, init_cond_format = "XV", compute_conservation_values=True) + sim.add_solar_system_body("Sun") + sim.add_body(name=names, Gmass=body_Gmass[style], radius=body_radius[style], rh=pos_vectors[style], vh=vel_vectors[style], rot=rot_vectors[style]) + + # Set fragmentation parameters + minimum_fragment_gmass = 0.2 * body_Gmass[style][1] # Make the minimum fragment mass a fraction of the smallest body + gmtiny = 0.99 * body_Gmass[style][1] # Make GMTINY just smaller than the smallest original body. This will prevent runaway collisional cascades + sim.set_parameter(collision_model="fraggle", encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + sim.run(dt=5e-4, tstop=5.0e-4, istep_out=1, dump_cadence=0) + + print("Generating animation") + anim = AnimatedScatter(sim,movie_filename,movie_titles[style],style,nskip=1) diff --git a/examples/Fragmentation/cb.in b/examples/Fragmentation/cb.in deleted file mode 100644 index 8766a22ae..000000000 --- a/examples/Fragmentation/cb.in +++ /dev/null @@ -1,16 +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. - -0 -39.47841760435743 ! G*Mass -0.005 ! Radius -0.0 ! J2 -0.0 ! J4 -0.4 0.4 0.4 !Ip -0.0 0.0 0.0 !rot !11.2093063 -38.75937204 82.25088158 ! rot (radian / year) \ No newline at end of file diff --git a/examples/Fragmentation/disruption_headon.in b/examples/Fragmentation/disruption_headon.in deleted file mode 100644 index 1f4b208f1..000000000 --- a/examples/Fragmentation/disruption_headon.in +++ /dev/null @@ -1,22 +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. - -2 -1 1e-07 0.0009 -7e-06 -1.0 -1.807993e-05 0.0 --2.562596e-04 6.280005 0.0 -0.4 0.4 0.4 !Ip -0.0 0.0 0.0 !rot -2 7e-10 0.0004 -3.25e-06 -1.0 1.807993e-05 0.0 --2.562596e-04 -6.280005 0.0 -0.4 0.4 0.4 !Ip -0.0 0.0 0.0 !rot diff --git a/examples/Fragmentation/hitandrun.in b/examples/Fragmentation/hitandrun.in deleted file mode 100644 index 285fc63a2..000000000 --- a/examples/Fragmentation/hitandrun.in +++ /dev/null @@ -1,22 +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. - -2 -1 1e-07 0.0009 -7e-06 -1.0 -4.20E-05 0.0 -0.00 6.28 0.0 -0.4 0.4 0.4 !Ip -0.0 0.0 6.0e4 !rot -2 7e-10 0.0004 -3.25e-06 -1.0 4.20E-05 0.0 --1.50 -6.28 0.0 -0.4 0.4 0.4 !Ip -0.0 0.0 1.0e5 !rot diff --git a/examples/Fragmentation/param.disruption_headon.in b/examples/Fragmentation/param.disruption_headon.in deleted file mode 100644 index 0fd657831..000000000 --- a/examples/Fragmentation/param.disruption_headon.in +++ /dev/null @@ -1,51 +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. - -T0 0.0e0 -TSTOP 0.00001 -DT 0.00000001 -ISTEP_OUT 1 -ISTEP_DUMP 1 -OUT_FORM XVEL -OUT_TYPE NETCDF_DOUBLE -OUT_STAT REPLACE -IN_FORM XV -IN_TYPE ASCII -NC_IN -1.0 -PL_IN disruption_headon.in -TP_IN tp.in -CB_IN cb.in -BIN_OUT disruption_headon.nc -CHK_QMIN -1.0 -CHK_RMIN 0.005 -CHK_RMAX 1e6 -CHK_EJECT -1.0 -CHK_QMIN_COORD -1.0 -CHK_QMIN_RANGE -1.0 -1.0 -MU2KG 1.98908e30 -TU2S 3.1556925e7 -DU2M 1.49598e11 -EXTRA_FORCE no -PARTICLE_OUT -1.0 -BIG_DISCARD no -CHK_CLOSE yes -GR NO -INTERACTION_LOOPS TRIANGULAR -ENCOUNTER_CHECK TRIANGULAR -RHILL_PRESENT yes -FRAGMENTATION yes -ROTATION yes -ENERGY yes -ENERGY_OUT -1.0 -ENC_OUT -1.0 -GMTINY 1.0e-11 -MIN_GMFRAG 1.0e-11 -TIDES NO -YORP NO -YARKOVSKY NO diff --git a/examples/Fragmentation/param.hitandrun.in b/examples/Fragmentation/param.hitandrun.in deleted file mode 100644 index 1bd02166c..000000000 --- a/examples/Fragmentation/param.hitandrun.in +++ /dev/null @@ -1,51 +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. - -T0 0.0e0 -TSTOP 0.00001 -DT 0.00000001 -ISTEP_OUT 1 -ISTEP_DUMP 1 -OUT_FORM XVEL -OUT_TYPE NETCDF_DOUBLE -OUT_STAT REPLACE -IN_FORM XV -IN_TYPE ASCII -NC_IN -1.0 -PL_IN hitandrun.in -TP_IN tp.in -CB_IN cb.in -BIN_OUT hitandrun.nc -CHK_QMIN -1.0 -CHK_RMIN 0.005 -CHK_RMAX 1e6 -CHK_EJECT -1.0 -CHK_QMIN_COORD -1.0 -CHK_QMIN_RANGE -1.0 -1.0 -MU2KG 1.98908e30 -TU2S 3.1556925e7 -DU2M 1.49598e11 -EXTRA_FORCE no -PARTICLE_OUT -1.0 -BIG_DISCARD no -CHK_CLOSE yes -GR NO -INTERACTION_LOOPS TRIANGULAR -ENCOUNTER_CHECK TRIANGULAR -RHILL_PRESENT yes -FRAGMENTATION yes -ROTATION yes -ENERGY yes -ENERGY_OUT -1.0 -ENC_OUT -1.0 -GMTINY 1.0e-11 -MIN_GMFRAG 1.0e-11 -TIDES NO -YORP NO -YARKOVSKY NO diff --git a/examples/Fragmentation/param.supercatastrophic_off_axis.in b/examples/Fragmentation/param.supercatastrophic_off_axis.in deleted file mode 100644 index 08b5dd71d..000000000 --- a/examples/Fragmentation/param.supercatastrophic_off_axis.in +++ /dev/null @@ -1,51 +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. - -T0 0.0e0 -TSTOP 0.00001 -DT 0.00000001 -ISTEP_OUT 1 -ISTEP_DUMP 1 -OUT_FORM XVEL -OUT_TYPE NETCDF_DOUBLE -OUT_STAT REPLACE -IN_FORM XV -IN_TYPE ASCII -NC_IN -1.0 -PL_IN supercatastrophic_off_axis.in -TP_IN tp.in -CB_IN cb.in -BIN_OUT supercatastrophic_off_axis.nc -CHK_QMIN -1.0 -CHK_RMIN 0.005 -CHK_RMAX 1e6 -CHK_EJECT -1.0 -CHK_QMIN_COORD -1.0 -CHK_QMIN_RANGE -1.0 -1.0 -MU2KG 1.98908e30 -TU2S 3.1556925e7 -DU2M 1.49598e11 -EXTRA_FORCE no -PARTICLE_OUT -1.0 -BIG_DISCARD no -CHK_CLOSE yes -GR NO -INTERACTION_LOOPS TRIANGULAR -ENCOUNTER_CHECK TRIANGULAR -RHILL_PRESENT yes -FRAGMENTATION yes -ROTATION yes -ENERGY yes -ENERGY_OUT -1.0 -ENC_OUT -1.0 -GMTINY 1.0e-11 -MIN_GMFRAG 1.0e-11 -TIDES NO -YORP NO -YARKOVSKY NO diff --git a/examples/Fragmentation/supercatastrophic_off_axis.in b/examples/Fragmentation/supercatastrophic_off_axis.in deleted file mode 100644 index 03315636d..000000000 --- a/examples/Fragmentation/supercatastrophic_off_axis.in +++ /dev/null @@ -1,22 +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. - -2 -1 1e-07 0.0009 -7e-06 -1.0 -4.2e-05 0.0 -0.00 6.28 0.0 -0.4 0.4 0.4 !Ip -0.0 0.0 -6.0e4 !rot -2 1e-08 0.0004 -3.25e-06 -1.0 4.2e-05 0.0 -1.00 -6.28 0.0 -0.4 0.4 0.4 !Ip -0.0 0.0 1.0e5 !rot diff --git a/examples/Fragmentation/swiftest_fragmentation.py b/examples/Fragmentation/swiftest_fragmentation.py new file mode 100644 index 000000000..d533bee0a --- /dev/null +++ b/examples/Fragmentation/swiftest_fragmentation.py @@ -0,0 +1,81 @@ +""" + 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. +""" +#!/usr/bin/env python3 +""" +Generates and runs a set of Swiftest input files from initial conditions with the SyMBA integrator. All simulation +outputs for the disruption case are stored in the /disruption subdirectory. All simulation outputs for the hit and run +case are stored in the /hitandrun subdirectory. All simulation outputs for the super-catastrophic disruption case are +stored in the /supercat subdirectory. + +Input +------ +None. + +Output +------ +Three subdirectories: +disruption/ +hitandrun/ +supercat/ + +Each subdirectory contains: +data.nc : A NetCDF file containing the simulation output. +init_cond.nc : A NetCDF file containing the initial conditions for the simulation. +collision_000001.nc : A NetCDF file containing the data for the collision. +encounter_000001.nc : A NetCDF file containing the data for the close encounter. +dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. +dump_param2.in : An ASCII file containing the necessary parameters to restart a simulation. +fraggle.log : An ASCII file containing the information of any collisional events that occured. +param.in : An ASCII file containing the parameters for the simulation. +swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. + +""" +import swiftest +import numpy as np +from numpy.random import default_rng + +run_arguments = {"tstart": 0.0, "tstop":1e-5, "dt": 1e-5, "istep_out": 1, "fragmentation":True, "encounter_save":"both", "compute_conservation_values":True, + "minimum_fragment_gmass":1.0e-11, "gmtiny":1.0e-11, "output_format":"XVEL", "init_cond_format":"XV"} + +# Initialize the simulation object as a variable with arguments. +sim_disruption = swiftest.Simulation(simdir="disruption", **run_arguments) +# Add the Sun using the JPL Horizons Database. +sim_disruption.add_solar_system_body(["Sun"]) +# Add a user-defined target body. +sim_disruption.add_body(name="Target", rh=[1.0, -1.807993e-05, 0.0], vh=[-2.562596e-04, 6.280005, 0.0], Gmass=1e-7, radius=7e-6) +# Add a user-defined projectile body. +sim_disruption.add_body(name="Projectile", rh=[1.0, 1.807993e-05, 0.0], vh=[-2.562596e-04, -6.280005, 0.0], Gmass=7e-10, radius=3.25e-6) +# Display the run configuration parameters. +sim_disruption.get_parameter() +# Write the parameters to the param.in +sim_disruption.write_param() +# Run the simulation. +sim_disruption.run() + +# Do the same as above for the hit and run case. +sim_hitandrun = swiftest.Simulation(simdir="hitandrun", **run_arguments) +sim_hitandrun.add_solar_system_body(["Sun"]) +sim_hitandrun.add_body(name="Target", rh=[1.0, -4.2e-05, 0.0], vh=[0.0, 6.28, 0.0], Gmass=1e-7, radius=7e-6, rot=[0.0, 0.0, 6.0e4]) +sim_hitandrun.add_body(name="Projectile", rh=[1.0, 4.2e-05, 0.0], vh=[-1.5, -6.28, 0.0], Gmass=7e-10, radius=3.25e-6, rot=[0.0, 0.0, 1.0e5]) +sim_hitandrun.get_parameter() +sim_hitandrun.write_param() +sim_hitandrun.run() + +# Do the same as above for the super-catastrophic disruption case. +sim_supercat = swiftest.Simulation(simdir="supercat", **run_arguments) +sim_supercat.add_solar_system_body(["Sun"]) +sim_supercat.add_body(name="Target", rh=[1.0, -4.2e-05, 0.0], vh=[0.0, 6.28, 0.0], Gmass=1e-7, radius=7e-6, rot=[0.0, 0.0, -6.0e4]) +sim_supercat.add_body(name="Projectile", rh=[1.0, 4.2e-05, 0.0], vh=[1.0, -6.28, 0.0], Gmass=1e-8, radius=3.25e-6, rot=[0.0, 0.0, 1.0e5]) +sim_supercat.get_parameter() +sim_supercat.write_param() +sim_supercat.run() diff --git a/examples/Fragmentation/tp.in b/examples/Fragmentation/tp.in deleted file mode 100644 index 3c6f40630..000000000 --- a/examples/Fragmentation/tp.in +++ /dev/null @@ -1,10 +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. - -0 diff --git a/examples/helio_gr_test/.gitignore b/examples/helio_gr_test/.gitignore new file mode 100644 index 000000000..8968b5dd7 --- /dev/null +++ b/examples/helio_gr_test/.gitignore @@ -0,0 +1,3 @@ +* +!.gitignore +!helio_gr_test.py \ No newline at end of file diff --git a/examples/helio_gr_test/helio_gr_test.py b/examples/helio_gr_test/helio_gr_test.py new file mode 100644 index 000000000..64ad2e388 --- /dev/null +++ b/examples/helio_gr_test/helio_gr_test.py @@ -0,0 +1,104 @@ +""" + 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. +""" + +#!/usr/bin/env python3 +""" +Generates and runs two sets of Swiftest input files from initial conditions with the helio integrator. All simulation +outputs for the general relativity run are stored in the /gr subdirectory while all simulation outputs for the run +without general reelativity are stored in the /nogr subdirectory. + +Input +------ +None. + +Output +------ +helio_gr_mercury_precession.png : Portable Network Graphic file depicting the precession of Mercury's perihelion over time + with data sourced from the JPL Horizons database, Swiftest run with general relativity, + and Swiftest run without general relativity. +Two subdirectories: +gr/ +nogr/ + +Each subdirecotry contains: +data.nc : A NetCDF file containing the simulation output. +dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +init_cond.nc : A NetCDF file containing the initial conditions for the simulation. +dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. +dump_param2.in : An ASCII file containing the necessary parameters to restart a simulation. +param.in : An ASCII file containing the parameters for the simulation. +swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. +""" + +import swiftest +from astroquery.jplhorizons import Horizons +import datetime +import numpy as np +import matplotlib.pyplot as plt + +# Initialize the simulation object as a variable. Define the directory in which the output will be placed. +sim_gr = swiftest.Simulation(simdir="gr") +# Add the modern planets and the Sun using the JPL Horizons Database. +sim_gr.add_solar_system_body(["Sun","Mercury","Venus","Earth","Mars","Jupiter","Saturn","Uranus","Neptune"]) + +# Initialize the simulation object as a variable. Define the directory in which the output will be placed. +sim_nogr = swiftest.Simulation(simdir="nogr") +# Add the modern planets and the Sun using the JPL Horizons Database. +sim_nogr.add_solar_system_body(["Sun","Mercury","Venus","Earth","Mars","Jupiter","Saturn","Uranus","Neptune"]) + +# Define a set of arguments that apply to both runs. For a list of possible arguments, see the User Manual. +run_args = {"tstop":1000.0, "dt":0.005, "tstep_out":10.0, "dump_cadence": 0,"integrator":"helio"} + +# Run both simulations. +sim_gr.run(**run_args,general_relativity=True) +sim_nogr.run(**run_args,general_relativity=False) + +# Get the start and end date of the simulation so we can compare with the real solar system. +start_date = sim_gr.ephemeris_date +tstop_d = sim_gr.param['TSTOP'] * sim_gr.param['TU2S'] / swiftest.JD2S + +stop_date = (datetime.datetime.fromisoformat(start_date) + datetime.timedelta(days=tstop_d)).isoformat() + +#Get the ephemerides of Mercury for the same timeframe as the simulation. +obj = Horizons(id='1', location='@sun', + epochs={'start':start_date, 'stop':stop_date, + 'step':'10y'}) +el = obj.elements() +t = (el['datetime_jd']-el['datetime_jd'][0]) / 365.25 +varpi_obs = el['w'] + el['Omega'] + +varpisim_gr= sim_gr.data['varpi'].sel(name="Mercury") +varpisim_nogr= sim_nogr.data['varpi'].sel(name="Mercury") +tsim = sim_gr.data['time'] + +dvarpi_gr = np.diff(varpisim_gr) * 3600 * 100 / run_args['tstep_out'] +dvarpi_nogr = np.diff(varpisim_nogr) * 3600 * 100 / run_args['tstep_out'] +dvarpi_obs = np.diff(varpi_obs) / np.diff(t) * 3600 * 100 + +# Plot of the data and save the output plot. +fig, ax = plt.subplots() + +ax.plot(t, varpi_obs, label="JPL Horizons",linewidth=2.5) +ax.plot(tsim, varpisim_gr, label="Swiftest Helio GR",linewidth=1.5) +ax.plot(tsim, varpisim_nogr, label="Swiftest Helio No GR",linewidth=1.5) +ax.set_xlabel('Time (y)') +ax.set_ylabel('Mercury $\\varpi$ (deg)') +ax.legend() +plt.savefig("helio_gr_mercury_precession.png",dpi=300) + +# Print the data to the terminal. +print('Mean precession rate for Mercury long. peri. (arcsec/100 y)') +print(f'JPL Horizons : {np.mean(dvarpi_obs)}') +print(f'Swiftest No GR : {np.mean(dvarpi_nogr)}') +print(f'Swiftest GR : {np.mean(dvarpi_gr)}') +print(f'Obs - Swiftest GR : {np.mean(dvarpi_obs - dvarpi_gr)}') +print(f'Obs - Swiftest No GR : {np.mean(dvarpi_obs - dvarpi_nogr)}') diff --git a/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_param.in b/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_param.in deleted file mode 100644 index ba1fb3c2b..000000000 --- a/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_param.in +++ /dev/null @@ -1,38 +0,0 @@ -! VERSION Swiftest parameter input -T0 0.0 -TSTOP 200000000.0 -DT 0.005 -ISTEP_OUT 200000 -ISTEP_DUMP 200000 -OUT_FORM XVEL -OUT_TYPE NETCDF_DOUBLE -OUT_STAT REPLACE -IN_TYPE ASCII -PL_IN hungarias_5pl_500tp_17_pl.in -TP_IN hungarias_5pl_500tp_17_tp.in -CB_IN hungarias_5pl_500tp_17_sun_MsunAUYR.in -BIN_OUT hungarias_5pl_500tp_17_out.nc -CHK_QMIN -1.0 -CHK_RMIN -1.0 -CHK_RMAX 1000.0 -CHK_EJECT 1000.0 -CHK_QMIN_COORD HELIO -CHK_QMIN_RANGE -1.0 -1.0 -MU2KG 1.988409870698051e+30 -TU2S 31557600.0 -DU2M 149597870700.0 -IN_FORM EL -EXTRA_FORCE NO -PARTICLE_OUT hungarias_5pl_500tp_17_particle.dat -BIG_DISCARD NO -CHK_CLOSE YES -RHILL_PRESENT YES -FRAGMENTATION NO -ROTATION YES -TIDES NO -ENERGY YES -GR YES -INTERACTION_LOOPS ADAPTIVE -ENCOUNTER_CHECK ADAPTIVE -ENERGY_OUT hungarias_5pl_500tp_17_energy.dat -GMTINY 3.646098141953443043e-08 diff --git a/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_pl.in b/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_pl.in deleted file mode 100644 index cd9d16020..000000000 --- a/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_pl.in +++ /dev/null @@ -1,49 +0,0 @@ -8 -Mercury 6.553709809565314146e-06 0.0014751274117575772341 -1.6306381826061645943e-05 -0.38709894990924181846 0.20562369687869339052 7.0036069691825035832 -48.302897646473702764 29.190213908309409874 163.69992642152809026 -0.0 0.0 0.34599999999999997424 -3.5735549824428292985 -18.380047749494480457 34.361526740492798437 -Venus 9.6633133995815381836e-05 0.006759122875155079725 -4.0453784346544178454e-05 -0.7233300630551103838 0.006773384545514573099 3.394505355540899938 -76.62090440289564697 55.183156101464518883 271.2285045598760007 -0.0 0.0 0.4000000000000000222 -0.17650282045605921225 -3.6612475825356215592 8.702866268072763821 -Earth 0.000120026935827952456416 0.010044657392872289059 -4.25875607065040958e-05 -0.99999328599172943033 0.01668004783869252855 0.0027793940989077428085 -175.84932558359508903 287.2227751976308241 324.72725799674782365 -0.0 0.0 0.33069999999999999396 -4.827962479462605839 0.034731626640621778608 2301.2114260455621944 -Mars 1.2739802010675941808e-05 0.007246146587933918669 -2.265740805092889601e-05 -1.5236121180553410248 0.093387475645674775104 1.8479297186242829021 -49.490271729763087194 286.7387645553690163 252.78317601821959215 -0.0 0.0 0.3644000000000000017 -997.9376283354346323 -909.38573894978675416 1783.4600697011568969 -Jupiter 0.03769225108898567778 0.35525381666404283465 -0.00046732617030490929307 -5.203268729924161562 0.04848413524543258163 1.3035624911873560094 -100.51639734596980702 273.421918018626684 325.351028522703416 -0.0 0.0 0.27560000000000001164 --80.967241888586720104 -2387.9998942634933492 5008.7344122962876782 -Saturn 0.01128589982009127331 0.43764770913411007376 -0.00038925687730393611812 -9.581513697274186114 0.05248801962394190196 2.4862838811768979141 -113.59546767797320399 335.45662431368151601 228.84653123700309152 -0.0 0.0 0.22000000000000000111 -441.9323685947327233 378.52918410105413535 5135.911248678291292 -Uranus 0.001723658947826773068 0.4699394560146697986 -0.00016953449859497231466 -19.24773626798451076 0.04408736292912442123 0.7704474968533898682 -74.09072726634606454 95.12631113857929677 237.66915583105441101 -0.0 0.0 0.23000000000000000999 --677.3000258209181323 -3008.109907190578637 -836.301326618569835 -Neptune 0.0020336100526728302882 0.7816500366521773358 -0.000164587904124493665 -30.297815841143489024 0.013873050398302080172 1.7688477929856469828 -131.74107055888509876 246.83916166351488641 334.07963351871291025 -0.0 0.0 0.23000000000000000999 -1231.0256802954641403 -2178.2009371051150557 2329.6179923847095223 diff --git a/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_sun_MsunAUYR.in b/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_sun_MsunAUYR.in deleted file mode 100644 index b2cb85c35..000000000 --- a/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_sun_MsunAUYR.in +++ /dev/null @@ -1,7 +0,0 @@ -Sun -39.476926408897626 -0.004650467260962157 -4.7535806948127355e-12 --2.2473967953572827e-18 -0.0 0.0 0.07 -11.209306302144773 -38.759372036774764 82.25088158389266 diff --git a/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_tp.in b/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_tp.in deleted file mode 100644 index 573541ac9..000000000 --- a/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_tp.in +++ /dev/null @@ -1 +0,0 @@ -0 diff --git a/examples/symba_hungarias/swifter/control_planets/param.swifter.in b/examples/symba_hungarias/swifter/control_planets/param.swifter.in deleted file mode 100644 index b39e5a947..000000000 --- a/examples/symba_hungarias/swifter/control_planets/param.swifter.in +++ /dev/null @@ -1,26 +0,0 @@ -! VERSION Swifter parameter file converted from Swiftest -T0 0.0 -TSTOP 200000000.0 -DT 0.005 -ISTEP_OUT 200000 -ISTEP_DUMP 200000 -OUT_FORM XV -OUT_TYPE REAL8 -OUT_STAT UNKNOWN -IN_TYPE ASCII -PL_IN hungarias_5pl_500tp_17_pl.in -TP_IN hungarias_5pl_500tp_17_tp.in -BIN_OUT hungarias_5pl_500tp_17_out.dat -CHK_QMIN -1.0 -CHK_RMIN -1.0 -CHK_RMAX 1000.0 -CHK_EJECT 1000.0 -CHK_QMIN_COORD HELIO -CHK_QMIN_RANGE -1.0 -1.0 -EXTRA_FORCE NO -PARTICLE_OUT hungarias_5pl_500tp_17_particle.dat -BIG_DISCARD NO -CHK_CLOSE YES -RHILL_PRESENT YES -J2 0.0 -J4 0.0 diff --git a/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_param.in b/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_param.in deleted file mode 100644 index ba1fb3c2b..000000000 --- a/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_param.in +++ /dev/null @@ -1,38 +0,0 @@ -! VERSION Swiftest parameter input -T0 0.0 -TSTOP 200000000.0 -DT 0.005 -ISTEP_OUT 200000 -ISTEP_DUMP 200000 -OUT_FORM XVEL -OUT_TYPE NETCDF_DOUBLE -OUT_STAT REPLACE -IN_TYPE ASCII -PL_IN hungarias_5pl_500tp_17_pl.in -TP_IN hungarias_5pl_500tp_17_tp.in -CB_IN hungarias_5pl_500tp_17_sun_MsunAUYR.in -BIN_OUT hungarias_5pl_500tp_17_out.nc -CHK_QMIN -1.0 -CHK_RMIN -1.0 -CHK_RMAX 1000.0 -CHK_EJECT 1000.0 -CHK_QMIN_COORD HELIO -CHK_QMIN_RANGE -1.0 -1.0 -MU2KG 1.988409870698051e+30 -TU2S 31557600.0 -DU2M 149597870700.0 -IN_FORM EL -EXTRA_FORCE NO -PARTICLE_OUT hungarias_5pl_500tp_17_particle.dat -BIG_DISCARD NO -CHK_CLOSE YES -RHILL_PRESENT YES -FRAGMENTATION NO -ROTATION YES -TIDES NO -ENERGY YES -GR YES -INTERACTION_LOOPS ADAPTIVE -ENCOUNTER_CHECK ADAPTIVE -ENERGY_OUT hungarias_5pl_500tp_17_energy.dat -GMTINY 3.646098141953443043e-08 diff --git a/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_pl.in b/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_pl.in deleted file mode 100644 index cd9d16020..000000000 --- a/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_pl.in +++ /dev/null @@ -1,49 +0,0 @@ -8 -Mercury 6.553709809565314146e-06 0.0014751274117575772341 -1.6306381826061645943e-05 -0.38709894990924181846 0.20562369687869339052 7.0036069691825035832 -48.302897646473702764 29.190213908309409874 163.69992642152809026 -0.0 0.0 0.34599999999999997424 -3.5735549824428292985 -18.380047749494480457 34.361526740492798437 -Venus 9.6633133995815381836e-05 0.006759122875155079725 -4.0453784346544178454e-05 -0.7233300630551103838 0.006773384545514573099 3.394505355540899938 -76.62090440289564697 55.183156101464518883 271.2285045598760007 -0.0 0.0 0.4000000000000000222 -0.17650282045605921225 -3.6612475825356215592 8.702866268072763821 -Earth 0.000120026935827952456416 0.010044657392872289059 -4.25875607065040958e-05 -0.99999328599172943033 0.01668004783869252855 0.0027793940989077428085 -175.84932558359508903 287.2227751976308241 324.72725799674782365 -0.0 0.0 0.33069999999999999396 -4.827962479462605839 0.034731626640621778608 2301.2114260455621944 -Mars 1.2739802010675941808e-05 0.007246146587933918669 -2.265740805092889601e-05 -1.5236121180553410248 0.093387475645674775104 1.8479297186242829021 -49.490271729763087194 286.7387645553690163 252.78317601821959215 -0.0 0.0 0.3644000000000000017 -997.9376283354346323 -909.38573894978675416 1783.4600697011568969 -Jupiter 0.03769225108898567778 0.35525381666404283465 -0.00046732617030490929307 -5.203268729924161562 0.04848413524543258163 1.3035624911873560094 -100.51639734596980702 273.421918018626684 325.351028522703416 -0.0 0.0 0.27560000000000001164 --80.967241888586720104 -2387.9998942634933492 5008.7344122962876782 -Saturn 0.01128589982009127331 0.43764770913411007376 -0.00038925687730393611812 -9.581513697274186114 0.05248801962394190196 2.4862838811768979141 -113.59546767797320399 335.45662431368151601 228.84653123700309152 -0.0 0.0 0.22000000000000000111 -441.9323685947327233 378.52918410105413535 5135.911248678291292 -Uranus 0.001723658947826773068 0.4699394560146697986 -0.00016953449859497231466 -19.24773626798451076 0.04408736292912442123 0.7704474968533898682 -74.09072726634606454 95.12631113857929677 237.66915583105441101 -0.0 0.0 0.23000000000000000999 --677.3000258209181323 -3008.109907190578637 -836.301326618569835 -Neptune 0.0020336100526728302882 0.7816500366521773358 -0.000164587904124493665 -30.297815841143489024 0.013873050398302080172 1.7688477929856469828 -131.74107055888509876 246.83916166351488641 334.07963351871291025 -0.0 0.0 0.23000000000000000999 -1231.0256802954641403 -2178.2009371051150557 2329.6179923847095223 diff --git a/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_sun_MsunAUYR.in b/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_sun_MsunAUYR.in deleted file mode 100644 index b2cb85c35..000000000 --- a/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_sun_MsunAUYR.in +++ /dev/null @@ -1,7 +0,0 @@ -Sun -39.476926408897626 -0.004650467260962157 -4.7535806948127355e-12 --2.2473967953572827e-18 -0.0 0.0 0.07 -11.209306302144773 -38.759372036774764 82.25088158389266 diff --git a/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_tp.in b/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_tp.in deleted file mode 100644 index f4ba244e1..000000000 --- a/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_tp.in +++ /dev/null @@ -1,1501 +0,0 @@ -500 -TestParticle -1.8454769027014339411 0.13951119042459186881 25.837798047275626345 -328.17117785206306735 237.2860880034895672 64.23008023926446697 -TestParticle -1.8948047399930760815 0.39253684339890981825 30.57401904357708844 -171.8160167926455415 74.67067835186652758 346.82539114732162489 -TestParticle -1.4322956873029448754 0.26682998123758877584 36.888797433998760766 -135.67836179139501951 49.89780708941236753 50.12940813296061293 -TestParticle -1.5422738860284694873 0.37685139101297421282 19.245291067203744717 -242.6056203622448777 190.34039186776647057 265.5775848896740854 -TestParticle -1.4000225346968613316 0.29255853399659431657 19.890767084525684538 -119.10518346196536754 348.49038108835299 47.293501598324468205 -TestParticle -1.456396703278512561 0.21606816556140612251 29.008692147879436618 -108.30731953608933793 221.35606614343436149 135.6522448644592771 -TestParticle -1.4991966146428574724 0.2669401594934397437 30.077755049056197123 -191.15663442447419129 222.38194219090249248 69.087779756302211354 -TestParticle -1.2976220185588704936 0.2964166811906516763 17.074990789432430205 -304.33208099940674174 258.6470139846816778 322.57928297363247339 -TestParticle -1.2284058459883253622 0.02114032275754222992 21.48034199376179032 -253.91897753388707315 121.66008318006832667 48.90451689677965419 -TestParticle -1.3491703154567693534 0.12631152383406446527 12.08570156851411781 -94.79536576066179521 143.49729046755351192 208.82266091055907964 -TestParticle -1.354548306636307764 0.30813073753578051894 26.385704559503864175 -9.340695923175923454 140.9062990975310754 128.60525944669927867 -TestParticle -1.4726763914941964906 0.051608113984077212677 23.16805302210511286 -60.87571895315940651 37.85205814142705094 334.24673224972650587 -TestParticle -1.5463324166991267994 0.049680078831149866725 2.1376306166210978787 -220.16008032774595904 11.76294270807032305 189.70726088424217437 -TestParticle -1.8424848789863070841 0.22250945291262835823 31.15994606422547264 -200.26190393952850854 90.472365503047569746 91.504582635979360816 -TestParticle -1.3344201535197020014 0.22773738327276721316 26.57752464191161934 -153.96142537752339763 186.86606427694519539 35.556703962561442722 -TestParticle -1.9184874234026485507 0.023481756935774280443 35.397883111232822273 -271.86866710708176242 55.05965672749781703 149.58202579969920976 -TestParticle -1.5321856218987717213 0.3979302949006976453 2.3033304058957959626 -1.0080751214383187886 229.5039187263292888 149.08850733126683963 -TestParticle -1.8579680598185155382 0.22191671822921349433 4.132202808256058013 -84.407322217061448555 105.02111083305797479 146.60404199861849861 -TestParticle -1.8191335218869923995 0.081164276322499742666 2.5841250683973493452 -159.5912052269758874 90.717444711181698835 52.736155424681527393 -TestParticle -1.3667350901122115037 0.040168371245059432406 21.275121073210776501 -354.85336821525999085 78.43154031841972085 317.9997578721723812 -TestParticle -1.211310325452651826 0.22495050228658303171 6.171244471860548586 -261.19666701924728613 72.22571277624209074 188.79752520382470493 -TestParticle -1.5325985395295633751 0.31279786859050073833 20.80765006283890628 -318.17303457104600284 237.18051290105893258 171.10337432510698363 -TestParticle -1.8680074840187885776 0.2359667145186353232 3.4681761306941005785 -200.43760942249792834 358.90361110235892284 209.24526446322295214 -TestParticle -1.8902919155434694254 0.083578216274719355217 21.112558775866592242 -196.8514015184809125 347.4309841941474133 73.29619835953663198 -TestParticle -1.3627905330289311614 0.099888583939379896326 10.927033380075510394 -304.94152566655765213 199.55238917120914266 66.700355986912740036 -TestParticle -1.6040569601728904559 0.0037929451167165065088 35.906866500389931218 -99.48570161019421221 264.107310263435636 196.91578900528253371 -TestParticle -1.5861188083181421149 0.12827049258664038889 4.433072269138715882 -250.35776905499878353 45.94314631274010452 78.766936071707490896 -TestParticle -1.8085832921727800215 0.38738844761580382148 38.482814871600758977 -59.61087191956130482 302.66582104517908647 337.43444136948141931 -TestParticle -1.4784945066780474932 0.02330664972959981679 24.805661482861435019 -161.3343149737517308 260.74004269183234328 332.58410511792851594 -TestParticle -1.2147867771614853094 0.16512447645289687892 26.704102750300808822 -342.71215159236965064 303.68316149292064665 267.30686157877283904 -TestParticle -1.2201597354758311198 0.29779565538112623413 9.5137682254248456815 -191.53033272117548336 279.0125127827463416 212.78518850631689929 -TestParticle -1.6306412809893466864 0.17831015307074157827 3.1250419675817919796 -35.17124037365346112 108.44038602029890228 289.87991262900078482 -TestParticle -1.2151606182820764435 0.030818630012030868992 15.255139624036321067 -18.872922094318155928 231.7787216922804987 114.00766773514217789 -TestParticle -1.263893046608108861 0.2365742775318666613 11.945519016269416923 -42.860493283933593034 103.96603523733477914 283.38829024952065083 -TestParticle -1.6208609899851271763 0.084237547629803233296 12.70952077968544458 -283.22127471251508268 16.774057774443846824 300.16022765529646676 -TestParticle -1.369439844040318377 0.02479558882423171795 12.8318676295292597445 -301.63112212878189666 317.34595898371384237 30.617048625074787083 -TestParticle -1.5997694540834734855 0.09458558350377295476 19.448014834633401193 -12.1917196597836952066 3.3679767469261356894 154.78568082871979072 -TestParticle -1.7665402755717471983 0.30325026057285930925 27.633560559304825688 -101.32565005973741279 173.42784439679959974 37.232060344515574002 -TestParticle -1.9955375108845494481 0.36780600821797326816 31.984293078717442427 -282.80116122029363623 340.83055441100248117 39.611552110590793063 -TestParticle -1.8068990906750328485 0.21026617244057629885 1.0616116239923245601 -148.12562556977400163 298.30253571723386585 39.94475612648128049 -TestParticle -1.6630081107132843599 0.2735942970781838346 20.393789507385111648 -186.34515293922132173 65.17268953054855274 249.5770342523899501 -TestParticle -1.7985429554004617181 0.32088199656574384333 3.421215620948947489 -16.760921442599428843 74.095210179753522084 131.64141600391005227 -TestParticle -1.4370805125444752193 0.33325879590334600566 29.297209939601689399 -179.87886700027897291 9.64820682838999133 185.83130754139918395 -TestParticle -1.4655739620290153535 0.017666725980597774298 15.194095015809558902 -272.98954032167330297 58.084307572382229523 205.40990717491945361 -TestParticle -1.8476543863511110111 0.38915614646375812358 11.917542586934226634 -134.42337723208845546 335.9708646376130332 1.2971084841705504687 -TestParticle -1.4590877868615714785 0.00229625206779173743 3.1321552894228821273 -234.02046406252858901 255.12979045887780671 16.475368403924544936 -TestParticle -1.3888300055647480047 0.04773585409741545882 20.980957411518524225 -232.75615771007392141 269.83840631297238133 128.91250646333895702 -TestParticle -1.9931456375147125204 0.36812801925517474322 8.575906190939374341 -75.54998759463583724 336.19060016425089543 128.81172294803698719 -TestParticle -1.8774492133690419138 0.3438244675687084917 23.038981078440741612 -9.8914055387747712444 56.58764160659445963 274.986529163730836 -TestParticle -1.3204375538736723428 0.08737144541036796774 29.974540925371840672 -221.62895491427303796 180.74872085610940076 337.40135640751742585 -TestParticle -1.7927656300808507694 0.117314349174642992835 19.184850306121404628 -206.67799209022632567 27.751086824061687253 298.02149638567931333 -TestParticle -1.7770751091671890265 0.19250351376309945972 9.172954305563960631 -43.26806500508915576 40.25028641050728595 238.70170337404292127 -TestParticle -1.974616589119178478 0.34407442172588997842 9.802858566374489158 -297.25364573770326615 87.77531802870282718 75.66951173963438748 -TestParticle -1.3863166307158814039 0.076685155941225657816 27.402627668756696977 -65.08259549484182571 164.8638775674021133 100.45589134667613962 -TestParticle -1.865440866859517488 0.1196471086364425257 11.945324988836505398 -268.187594819792821 223.64720186520361267 29.40940210460087556 -TestParticle -1.924611171111724417 0.20112445232693854091 27.71898676703103348 -318.34445645026778493 191.25112555799532288 349.89422766228875616 -TestParticle -1.5993892099645203864 0.10968442780595713537 9.326690310948993812 -31.533935713187357663 310.02898225335894722 210.51997485541662058 -TestParticle -1.2359382488484538243 0.32658357473851062913 38.707976308555153366 -144.00217869231852319 119.06805794770258444 79.384200277529473055 -TestParticle -1.6109049166063780234 0.038297945827820673026 19.543826335927839466 -187.13697315293387646 257.17832502585736165 137.87766714187893058 -TestParticle -1.4314628393318562516 0.06605107757031168647 34.48524969280026653 -261.32336202719972107 132.91845049023550018 38.845354985336733478 -TestParticle -1.6270574875899108669 0.34703206127568098083 15.7198484814636287865 -347.55110983950402215 301.80674145531685326 112.25474179150697296 -TestParticle -1.2336395323546296421 0.09729394203067305569 5.1016432554912771735 -233.12366663108903708 146.38256752560837981 198.90738568911748985 -TestParticle -1.3456767380773657639 0.0037474665741684012703 39.938234490697439583 -256.57759604724572 75.054619437472723575 358.3650510442133168 -TestParticle -1.5755427111046413913 0.26176654357687628716 8.3705428253832359076 -37.517264866504824283 65.328654571322900324 91.55626866074713632 -TestParticle -1.6755570822166401257 0.13402717291758836637 24.063895956419415256 -13.799270685071709508 72.62055343894668624 87.31894896673983908 -TestParticle -1.5559490988866435668 0.15176826381840774483 38.48111346610262018 -256.2333379875098558 75.97800331031197629 59.41813313856062706 -TestParticle -1.44994652075586683 0.33986546456988747655 24.751134550954795088 -232.18945993885864709 196.68218102285592863 134.45246030705607154 -TestParticle -1.8429185809905443971 0.017095748280579449452 37.139787427802218645 -161.43471520401584485 307.27501647662722917 355.50902004252696997 -TestParticle -1.8754638534803846905 0.012020551314167439438 25.689663713162978809 -190.79044364156195002 199.61943428385487209 354.13757823278496062 -TestParticle -1.6785085343609076336 0.092751885821403062815 9.210612929641403213 -285.5852225501039925 151.86743084166838003 284.55869958326974256 -TestParticle -1.6543220378661067649 0.21134650270613800083 33.840207882222927083 -304.1335703446064258 326.82908020011677763 324.19035648687139428 -TestParticle -1.532142838634183768 0.38007507167758092237 0.41347334753230935434 -67.05133558163640828 34.399290053628249098 34.840294234675972973 -TestParticle -1.5607062121608026306 0.33781855969656376937 8.967843423326943508 -299.3643723824862377 200.63715648972143413 68.959909224159687824 -TestParticle -1.4493452438508076519 0.0685471748773834183 8.6320194163908645635 -72.080624314054560386 115.122237950328312195 0.4079154529894424286 -TestParticle -1.6460340581063395149 0.39668168452346741493 20.981074587513283802 -204.3451792276263177 201.37614636656564926 213.30860176845612841 -TestParticle -1.5920263567710581931 0.25848484530126630832 37.015946260712674132 -127.874562568991194667 65.19741011690945243 94.70447850395582634 -TestParticle -1.7336512363309442009 0.07029270812373322741 2.7619103909209741232 -186.8230602145383159 227.39378660430725176 98.630627655617857386 -TestParticle -1.2180382444813300236 0.3142235003505371993 28.081856084101627147 -111.345098722858793394 55.920002664921518942 282.87486367297071865 -TestParticle -1.6485319714902004762 0.3152277024193525512 9.613333711481617527 -294.21829832085342105 286.30105207001298595 128.67843292368630159 -TestParticle -1.4661249318513216444 0.05768902442216044396 0.40134055259916312508 -131.60830524837382427 243.75402215940340511 207.34266824752899083 -TestParticle -1.9808876352137643195 0.14308188258148502037 1.4378912336896432222 -80.646845170624999355 231.53252144735679963 232.24754717746816368 -TestParticle -1.2317104124445219515 0.2601604050852836525 0.45344055155487783537 -196.60019387641727917 281.28440095008312483 247.80040663000707468 -TestParticle -1.9766606334273690848 0.34561610666945052905 23.435434834980789276 -34.473035596172188377 271.1594424183512615 48.466138898201464258 -TestParticle -1.902283887520531902 0.11209856668107276434 36.03239655947709963 -294.40684092368923075 270.02199923071918874 114.382104661423511516 -TestParticle -1.6492323095244016962 0.15893979864294510707 37.659784271934086064 -104.66474319501168111 339.31942052690538958 216.02473301930888283 -TestParticle -1.3484148267391067311 0.21111072648635398341 10.89667366492733791 -291.56591682201212734 76.70162083026228572 312.33817224861377326 -TestParticle -1.4294351818194139803 0.088023727454350997323 39.975651469559892348 -198.68831704157523177 24.599669214308292453 112.67218982565516683 -TestParticle -1.7462490440076519072 0.37071438804152889723 21.870120107958371136 -306.73669065023256053 227.86908802150850306 221.53115484665687518 -TestParticle -1.2326287663421375829 0.38251042858385364553 15.802748366587309192 -199.40278420565533679 149.69869717845381274 315.67560896416114247 -TestParticle -1.8450862453370659999 0.35823810152470403345 0.24296995062495163609 -231.11355647090658749 268.36408970924156847 247.20131497380242536 -TestParticle -1.3463306194321635889 0.054152156717265725883 19.291673537548810202 -161.87111271376406307 110.46662751206984865 211.17562619004070257 -TestParticle -1.7304729990392044847 0.0060363382745066036794 4.5425988088905189244 -83.83165898233737323 161.12905358043980186 286.6647995328502816 -TestParticle -1.272415258736352639 0.34812105948963872892 35.045494396081245725 -14.574000729875393745 353.3713665259786012 131.5433867402096837 -TestParticle -1.6439273487752854574 0.36545065070539850538 6.353634441759323792 -208.14453818563018217 10.813063425795590433 206.06730287545840952 -TestParticle -1.6763079933342956984 0.094138501830316120844 9.085159707293687603 -80.58871476637817466 314.0368013316636393 100.690960685859835166 -TestParticle -1.4877140448295171904 0.16166761889883485281 34.241465691047999087 -79.8410863542756033 83.93580251433438377 326.42504725591442138 -TestParticle -1.2162284372972316238 0.0041396912261435492297 18.10971019209766908 -119.24015567046335207 329.67281909144981 104.828869567280364095 -TestParticle -1.8047735542382463692 0.33749016396948239294 0.52972364011479644574 -178.94392698813351217 299.23756071934496958 162.62104380151879468 -TestParticle -1.5839648306862472715 0.10066137160625268643 33.26828317225646714 -263.27920251880794922 68.67162164080139064 57.290691877799474696 -TestParticle -1.782207613297600135 0.28298109588186182162 35.127393670730072017 -210.15608294480230711 329.15212439443854464 156.34171670624388639 -TestParticle -1.3155167265331972892 0.3723026355627080397 31.9899066241260428 -91.31036979040656831 223.20537501312867334 55.827047719351739374 -TestParticle -1.5449962589928503132 0.042895131418722920458 19.621615335811604552 -53.274917868286941314 105.38186162729587636 323.020751462690896 -TestParticle -1.5754411317280814231 0.34816180369684263107 4.7678217298113434452 -120.95128002085144203 157.00930158977180895 240.29746717057042815 -TestParticle -1.5907469291141598244 0.1964357827791012312 32.411571541856559975 -170.61499094134663324 242.1650203501031342 17.501615221478704854 -TestParticle -1.830089894183755117 0.1183426089423230132 39.644525581214999477 -294.65378437812546508 109.07115594302160844 324.16241183209581322 -TestParticle -1.4367780052388956502 0.36401192064177911867 30.631206179017613778 -68.80265368578432117 273.93063220366155974 24.29554655983004352 -TestParticle -1.2142291174104986595 0.26599477562223389215 38.323418486729934784 -308.15266716976327643 181.95454939706644382 25.317934141736472498 -TestParticle -1.3097560558867786806 0.27086655670790987793 26.727111485760552512 -202.01817831967753136 111.97198753257944759 220.9572217341067244 -TestParticle -1.7068002319397266309 0.13225077417056724238 27.615823462695185952 -285.91192474987235528 163.31636137404424858 93.38394269951035653 -TestParticle -1.2055264990732839081 0.30786309414395046646 1.0578708063967390274 -10.359167032075170312 91.437369236993205845 199.49137469503560283 -TestParticle -1.507944679481377559 0.24354603379899894544 13.546984987329334871 -57.02677054315793015 348.2783664994595938 271.03255123935065285 -TestParticle -1.2000480949162781741 0.37393642722973008397 23.203234027939288353 -10.544426197782676979 54.256441116884829512 254.63780531903708493 -TestParticle -1.7449420987438828412 0.24948442565304040919 27.500692921539069857 -95.99564887831238025 273.51317842100650068 326.03984845413532412 -TestParticle -1.3765488182504534986 0.030416876982825514358 31.70464034258963082 -275.78595003182448409 133.87458225546748736 226.00553898246667472 -TestParticle -1.2429016633522536051 0.20958324622273286075 37.67591956683881449 -291.1872246516109044 179.51252843010638571 313.71221570905379394 -TestParticle -1.350836711566139936 0.37146863516149991602 10.648022816293165604 -303.44796444885918163 189.14789607745939293 51.43707686446851568 -TestParticle -1.3606071504125110128 0.33726059408562408803 29.623948782469774699 -174.22516541583135563 294.25596249059782394 95.41136217835122579 -TestParticle -1.2613426667283003102 0.28493782233230641188 2.8418286626483357793 -28.660785941482401995 87.50329638280636857 62.24419865756345871 -TestParticle -1.7174163570319429528 0.3032422501079781174 15.67069716211129915 -199.70972264612359481 32.767912430781642286 213.64123907162533555 -TestParticle -1.7458843970753306074 0.11283265730661723447 31.014841487303186796 -100.348702433335944306 70.42890181497725166 181.6379350423849246 -TestParticle -1.5856984450767472872 0.12800000166780992061 31.429108868252029652 -51.353858554652823898 23.612627758947475343 267.08391560632128403 -TestParticle -1.7153544980924069208 0.009492334383937130193 23.973160269033186864 -225.8121095708202688 166.53019043018878165 111.264606624241494615 -TestParticle -1.5026214783945404108 0.0060590469509819834884 26.922409196875427995 -295.19858318066900438 267.2316600455114326 164.01625566186100968 -TestParticle -1.9160661225785111661 0.2687972938601586037 36.621056515844763624 -334.838998311582543 64.064850181025448705 189.01682882741042135 -TestParticle -1.2176400162982947695 0.34785736514134202313 33.268864900617138858 -225.50438622677125977 227.27950095352301219 349.3797741235012495 -TestParticle -1.2273892818311689101 0.2816869543044054902 29.30501713210593806 -5.1819190308878404494 2.980732803128396391 210.95489861072306326 -TestParticle -1.3751089556704734207 0.2405885452138842584 36.06217993351511808 -199.72275209903938276 20.656954375719962513 63.697518910616103938 -TestParticle -1.5607369467841181176 0.07255978851264624496 7.9579329131271947517 -171.37467949380453547 212.58991825508687157 339.50383959100975062 -TestParticle -1.9532502979079398031 0.32689490765476852951 28.253212569212344363 -181.63986801834479934 358.1359989621613522 109.388744074059957256 -TestParticle -1.6386262719092012929 0.3843259001434648492 30.427684580834899464 -231.68744967547161195 57.857403700081057707 50.909305856223930675 -TestParticle -1.9782962700915884824 0.107957633562424437645 12.967168829872832703 -304.82496750248236594 137.36222813798312359 43.932431234771847528 -TestParticle -1.456906303967715921 0.14977091087281488302 11.183659205458482688 -73.40451433078203536 248.31190118288742497 75.220198402857562314 -TestParticle -1.2534896538060293913 0.32164641810767541363 3.6905727779895203255 -113.638768774667383354 40.160334282501267467 312.87037322501493009 -TestParticle -1.3014118589240171175 0.2335136721159586648 25.377666434917763638 -52.35427893272325406 9.000303326532378634 144.16353907228875642 -TestParticle -1.349118336295686893 0.043025081648941171375 4.3612305774961734883 -243.8860202407295219 2.8265136490351139287 103.60819968189791496 -TestParticle -1.3275933491849711832 0.30130671835155509175 9.869222679372882112 -140.91605869565009357 6.9406462242691979725 239.80228459696834875 -TestParticle -1.6818942627306852078 0.31620420657586079116 20.559233470145720446 -58.349404997197098055 117.22724335851061994 205.33268031856118796 -TestParticle -1.9852083696659352796 0.013418902816453127241 34.384158548277603984 -115.09964166928982365 93.38072290721305535 50.024657651717582496 -TestParticle -1.5693995761001753309 0.16001215059117473993 34.5933607052273544 -148.74442398288778122 35.382707682911650693 307.9784638941427488 -TestParticle -1.5266059802597138351 0.017927011927562432753 36.548915878020643788 -210.40292925773331945 201.71103729618005218 224.16233740901310512 -TestParticle -1.728092867591788595 0.17808919848065529745 20.998516569906101381 -308.92264952207932538 127.645229747456198766 161.89916144859373048 -TestParticle -1.6194915162303571421 0.12309065176675240694 11.294533006684988052 -54.678975810373955824 126.54242973288489793 198.90789595722705485 -TestParticle -1.3289490961949892434 0.29324085207912647943 30.6374181063208475 -269.87631534747202977 37.841881250480767562 348.01538484590025746 -TestParticle -1.992893537374311741 0.18673594337410803767 16.540817363482574365 -17.388276030638827763 78.86833627776049127 145.80382488854473877 -TestParticle -1.222299452110788831 0.30906300615816389987 12.345442063899700003 -306.8123712805751211 180.92912639536746155 259.40768755027107773 -TestParticle -1.4975645450575401085 0.33347394063389190766 1.5908406722909917974 -21.190900575813813589 29.47013297848204516 102.16591862721205075 -TestParticle -1.7529928369432026258 0.37348208125904397425 34.962456206016206295 -93.100816365900570304 51.110432866675402863 102.57164314281175166 -TestParticle -1.2425425262626379475 0.33615312037358630048 13.5646379554957707825 -178.52596605015196474 153.15866826328647221 144.53495382113527512 -TestParticle -1.6649955177303406018 0.2774227948724269921 0.19107601744351665474 -63.095836643914225306 354.85824120341573007 264.91047609564412824 -TestParticle -1.6484772171416994802 0.30267580759790019274 20.681865450161470932 -178.44791810461956061 236.1847171609527436 98.36374690667254583 -TestParticle -1.9932276245336744136 0.28313215139520719887 18.707112367987669188 -219.87647284127007197 126.12068590426943615 215.87266615210091913 -TestParticle -1.7032561164628601258 0.16397636271323282053 25.251751880173408438 -216.40546882883455737 157.48365299675131723 4.688955472432070337 -TestParticle -1.6688736346909214259 0.20206175633607201259 6.8253656041650678787 -216.49653061411731869 167.29352654167502124 264.9681676707442648 -TestParticle -1.8685421164356719181 0.017115665378235479788 37.702745220955684147 -341.22511657108503869 114.98911860271485352 180.97443389686239357 -TestParticle -1.2789089584183417347 0.38311485210375972876 34.310997435004189526 -320.3337196375490521 323.3381621809996318 259.21085923985185673 -TestParticle -1.6140662295704462093 0.22523087980360034788 31.289184028405010451 -342.24508460858135095 15.680010847649224814 231.38490121660879595 -TestParticle -1.9392715602121850527 0.15801671085680726869 28.474643946647489656 -130.88611486656463967 107.8187080577375383 123.51635573428578141 -TestParticle -1.2967745250719693306 0.06567169524305174755 33.95229338812422526 -290.63873117229752552 79.02208966627722475 232.82648238779003691 -TestParticle -1.5129927102068225775 0.035355940722157398748 39.88868697475624714 -192.95122284146495417 161.94702337269632153 136.8613631323482025 -TestParticle -1.6829217923833816872 0.25345881856811941502 11.3639096364677563145 -97.75123136727515316 45.772970150424697522 122.47944569483230737 -TestParticle -1.8496796135868087685 0.13179006688881342302 13.3337440463942780156 -265.13170996725159512 228.43295285296423458 86.46213418755671398 -TestParticle -1.3358066112403499393 0.14376027444378572384 39.375717961581145232 -157.40058260425848857 311.2848447975355839 331.54934076273463006 -TestParticle -1.4724981157763801232 0.09732120033570890172 28.321058818578286775 -59.894734856092107123 278.76518901350408441 80.89976806352470362 -TestParticle -1.2021644761475605012 0.31023967350442599455 28.526439154406524779 -141.17072146741031702 348.00301966689602295 345.1342457342993839 -TestParticle -1.5593994326172748721 0.1667781483451987734 33.654370780663562357 -266.88153921797828616 15.430552831803581171 331.4077165346525362 -TestParticle -1.2450357937715832435 0.028817230992748132934 35.27994061369459189 -170.88739535567884786 353.3811233168729018 235.24134924372253863 -TestParticle -1.9317961733915889333 0.3664316651845210826 24.216703033341396178 -53.371442738369651693 125.538665606108594375 100.18756180685251422 -TestParticle -1.6396980067944455506 0.35320738196817447196 38.908475459351436143 -246.96073709218802605 107.071264330560637745 337.8304256083255268 -TestParticle -1.7122870680368271756 0.33138468975426782492 22.34571124430782163 -41.625350595521808827 260.11274001626304653 319.5586433718779631 -TestParticle -1.7758391618474895779 0.055654577054355419685 14.384020683089943304 -218.7045008460380302 129.23569045343450057 314.73455478475153768 -TestParticle -1.8362854949156799389 0.17009562329070515574 9.220110348963054037 -5.6249185474454588274 94.48961934631255133 267.2078794777070243 -TestParticle -1.7334953226477165522 0.049544865778679184065 1.209613515173937337 -190.91534544660109418 64.56511824447872527 53.933623678817561142 -TestParticle -1.2066506827151026737 0.27307016461379868266 16.286012208431877468 -210.72290400454269843 4.9513407455376867716 217.19883427837939394 -TestParticle -1.9341836813541077866 0.31275777164344914505 21.744449246528134267 -16.671280260299788267 359.76195227232665275 224.80650775703034583 -TestParticle -1.2301271999661356205 0.031548406830605689455 39.849035058731047343 -90.34650036320888944 228.990784368342986 250.85529561169511226 -TestParticle -1.3410010761068889007 0.095083624572690483845 16.924908171363043152 -283.45379909314135602 86.752474366828209895 159.59709647132103782 -TestParticle -1.7698211243948773763 0.31273331984328978095 32.406541703763409146 -142.47083941877434654 108.934565017581746815 272.0311071315450704 -TestParticle -1.2184663095396561783 0.03812658809257066239 19.774618927626171683 -209.47233898474567582 217.91859195187419118 328.76297389338390076 -TestParticle -1.7206223471221142596 0.34602085721486458558 1.7719525390753965155 -165.06371680688690162 58.713339280074663407 131.55475352151159996 -TestParticle -1.3109621100006574324 0.1200549161067526599 35.241813901823853428 -280.10060451829298245 304.5154307276658301 258.67615548166588724 -TestParticle -1.890762195590066419 0.37035990280942132635 39.30878687557294171 -331.52556729751103148 337.10887406621617401 291.2002557551665518 -TestParticle -1.9459727148429868393 0.38159291851530796613 17.491010561827589953 -58.69944071533900143 205.64445683266583842 15.007877403052006571 -TestParticle -1.932411276121311472 0.04777930483056436195 25.073992516822389831 -121.57030712562516328 70.74439140769348455 289.9542940845957446 -TestParticle -1.5709963526669437073 0.10007382494413469276 31.19225199749002897 -25.663181434794644531 158.74882487098793149 349.24010777437848674 -TestParticle -1.335652850395929736 0.2682557203404010715 35.328293558121892204 -297.5826541744638689 60.254502441132032686 46.73892963602791184 -TestParticle -1.2957464098764572835 0.3440291712383192757 7.1735736922541004645 -59.24135447472242788 112.00172550339377153 63.553063734303997023 -TestParticle -1.3376569963037119315 0.3060189431378071423 33.029029350979975277 -152.73585490781837848 358.84231030107730476 37.635854669405638617 -TestParticle -1.771988403745682561 0.3418762364008507415 23.489318587551395012 -127.772934823946343386 203.78581662446330824 143.76143168311298837 -TestParticle -1.5956560402916708519 0.10759642083325884898 23.037334274387120558 -89.123439540602518605 335.80537435903943333 224.2944293252393777 -TestParticle -1.2213248137275627414 0.33273129495412528955 31.736197966218284705 -5.8113766822153190006 136.8878783815157476 64.522354495354704795 -TestParticle -1.5939091087487726739 0.18821654046060146137 30.731370977849337578 -266.58533763467028166 61.609425727717933796 18.235581197999763958 -TestParticle -1.7396585716134431721 0.33855494953671660951 29.449893101775622029 -180.02468739427200717 242.14518561194594781 286.10286226317128921 -TestParticle -1.282393302513987976 0.18117160916878405352 22.308223599873976184 -94.69043575838269078 120.90458523599184559 161.88428102391287666 -TestParticle -1.6814135190699217581 0.06566827687818244108 23.327233678731047917 -13.505074850212492876 48.75637107914376145 337.4546628636448986 -TestParticle -1.7657157709814490509 0.1428403447023711692 17.528150255810068359 -344.59038571613109525 139.36370104693307326 48.933862071120714177 -TestParticle -1.6903656227398606848 0.1881104051902828811 4.8333955434429443088 -225.1651227652955356 185.18882646555431393 132.21080070182574673 -TestParticle -1.994803202974419154 0.07010640681945860819 10.335500705227271823 -49.13850067137512667 6.4534592639328725028 80.823883651112907955 -TestParticle -1.3332640591247215678 0.06033190012542344327 21.035357456357957062 -97.733488288704805314 80.36567051536489714 46.55202086502264791 -TestParticle -1.6243595893431250765 0.19184864274731788791 3.8955991274805690239 -177.92659068814418788 143.40326100313114921 22.678654943892524898 -TestParticle -1.6823664970435372457 0.2224783311899178051 28.355960754425314718 -38.26291967170601538 109.90023925961423856 198.84047030132839495 -TestParticle -1.7191941261517613704 0.33174274738319786682 12.850948299491872007 -119.00419547116645447 97.60779700546201809 294.77008528831782996 -TestParticle -1.8572892923802768461 0.35111820477995814294 13.9604529367616514435 -90.00276864094306006 148.95323888923235245 105.97452396122218943 -TestParticle -1.3153721536816338489 0.19649899863576869574 15.0714118102473335625 -114.91054594701827796 42.412124805715073705 238.87013655434262205 -TestParticle -1.2329176043622995795 0.016982564457388795581 30.243701002322488591 -82.65191789811144929 330.6979385476704465 45.054558348890076047 -TestParticle -1.5821710473264454233 0.3143035815568485103 26.914241767154372553 -284.2538985550680195 218.88177874336824402 323.40347760377426312 -TestParticle -1.9040784761593252394 0.24428308876647972236 7.2140984856285061966 -36.905471182196343705 235.01221091601564694 318.38458893259758042 -TestParticle -1.65303582473123023 0.15480622128373774937 30.612597160930445028 -176.14307295689886246 344.8917806440758227 46.391668294041863874 -TestParticle -1.9906869462994456477 0.08417977136701382257 32.071163809129458855 -190.08888099464044785 12.337459747731131188 44.2017470332212028 -TestParticle -1.8765384210009301569 0.18365454827241262103 21.70846970886060845 -357.147106806575664 129.14807435709019501 12.280707552849744246 -TestParticle -1.4155101547192867617 0.04021447505437234643 9.344979114904226947 -15.0079117011066429654 104.10136849327774655 23.129488238006107537 -TestParticle -1.8212138878170127665 0.08047272581333581032 4.0968495722748254906 -174.58882187338159042 279.87646692565357398 23.324854698976157152 -TestParticle -1.7644240552946159895 0.028115303133601266677 37.495056810553286653 -118.13225365926875554 167.45393279647143459 34.012411764895496447 -TestParticle -1.4525677350618968475 0.30250405555180709394 17.82996354610970613 -220.00796720803919015 344.15563445760545846 123.14676507835467589 -TestParticle -1.548841766197246228 0.09540860671062662002 22.684926251185043355 -218.60911597389889494 90.33458573673138403 102.992143880334552364 -TestParticle -1.2079296534119159379 0.32769989355099571338 38.675927266126485904 -200.13361220962531206 158.78840734969233495 279.3835775172844933 -TestParticle -1.377134208847530239 0.24021816899861267447 9.0547885117482262984 -307.8373588937357681 250.70142057430294358 309.94009295835280682 -TestParticle -1.9686740753046718666 0.039229853667286734842 27.8754113045622951 -44.123357114694904624 256.01312835054108064 261.81824327677321662 -TestParticle -1.5814217806739057082 0.17335298748077404563 11.896107065940920933 -11.863952502714919746 24.317879056812333971 281.83737446678952665 -TestParticle -1.3875566874932281358 0.04186652452005912295 8.374003796839994962 -110.23215119957482955 294.56036703267886878 295.56595853737684365 -TestParticle -1.3902402383167473676 0.19593968424019078678 29.315181048510574158 -282.62385234829253022 324.77635841333739108 19.922520312932118003 -TestParticle -1.2840096543928043449 0.29990999639214999117 38.008971094948456937 -277.38971452757238012 208.06148201248271334 255.09629766073103951 -TestParticle -1.5591506829846155657 0.37436941724804151388 28.992037551395654305 -349.16296285001351407 325.2167596752620966 272.84514086043867565 -TestParticle -1.6470838643939573753 0.08288833139777805614 14.577369178129217175 -285.2260666698484215 331.09186078156602662 265.88764593799055547 -TestParticle -1.4078732644616405167 0.12168143435803764618 12.108634490395427719 -108.46688890223232704 161.29947110408681965 275.03585750375651742 -TestParticle -1.3806299194725459856 0.004926651150672434372 4.619034071475587311 -124.92525284958901466 247.86360149925218366 213.62866269117026263 -TestParticle -1.3192455632849615643 0.2895763215200138352 26.694213488950907731 -156.54596065699396945 129.81140517153278324 134.60446380394492394 -TestParticle -1.4439912056109245331 0.3898931766577775071 8.96508289894697441 -244.87528934455733065 193.64710431202621521 293.37512055758975293 -TestParticle -1.8635206283775769265 0.2795056553246003106 32.898054005194971694 -137.04912054787823195 287.93791057659291255 10.142083183616289688 -TestParticle -1.9812056783962854745 0.2247292940884803858 25.532351672534726816 -201.33822039314060248 254.90475216060337971 359.59652623258176618 -TestParticle -1.9116361511506723136 0.34944272223947114853 5.3334830645261233073 -165.89953551606566862 87.00762822041266986 286.54555713608760925 -TestParticle -1.2300510950958833956 0.09272681808089294764 6.1108306263088341126 -60.392041334648261852 166.06618730050502108 214.40030029409305712 -TestParticle -1.6587060971893274886 0.35283027123356813792 31.860313399205129059 -249.71240866151026694 222.43577149272385896 31.641338378167219503 -TestParticle -1.6042337378433173534 0.37025740688655151 17.202399535173533707 -87.81318396148407146 2.5620013176806422095 357.37399955588330158 -TestParticle -1.6471345300326571959 0.13620174045721983314 22.615216955031499424 -80.62529682810802001 69.592694813600971315 105.76774944494903252 -TestParticle -1.9072984229216274343 0.01501546063666405785 8.290907351796761304 -169.80316939963415734 18.043578597928426888 349.8451486157899808 -TestParticle -1.6906614679737514972 0.18058500638001656613 35.641943093270654686 -155.08172745880321486 318.8449035930426021 193.87642754894059749 -TestParticle -1.5896626347240321309 0.08039921506021037445 26.884736251329634626 -93.207751799271306936 291.57502433845007772 164.72382015911426834 -TestParticle -1.6992934898451703685 0.065201137301299824656 14.269610927403233447 -236.09727012824436088 254.53147047225508004 263.77965229044838225 -TestParticle -1.8538533648632840034 0.04766458860664664343 32.873078543951940844 -204.22879507518445052 106.636047257291238566 249.48280450502983285 -TestParticle -1.4212096807741136928 0.07499446462853280593 23.101996292119086007 -275.60817514452082833 213.13272785623379946 230.30352647630064666 -TestParticle -1.7510124795524912855 0.057099861992605485672 26.912262589245482758 -293.1635508220617794 35.9907631662996792 141.04718451469835827 -TestParticle -1.6563019761734052437 0.025865878674105769602 36.786210320613299984 -182.00701529286254754 302.4937526698793704 324.59294681664295013 -TestParticle -1.729605636071602337 0.11527751871838157194 8.269004569267789151 -347.6614584046645291 246.54991472345386683 257.4460526186617244 -TestParticle -1.5759605048363587443 0.11372511990649024349 2.1138568479458896832 -32.388292718466615838 301.59398434276658918 321.32099521949635346 -TestParticle -1.8344051151510727404 0.26899383835918777574 3.9802801398091425256 -84.71344253866337226 168.80695388443507454 259.706671920307258 -TestParticle -1.9193495257732000603 0.3433984358229728029 11.27141574019314163 -62.069125737912351326 344.62614387614092948 49.455425729806016477 -TestParticle -1.7910635325425254827 0.044197943689674758228 33.673496401958495028 -49.096060175323778196 333.20352819343492 344.1647888658290526 -TestParticle -1.3951416310339623816 0.25049231139019290104 13.926920554033479505 -24.468782285640848784 283.9433213127680915 38.716618949049291132 -TestParticle -1.4774439717601555166 0.34321703341922732422 34.23200733980726085 -253.1569295809615312 208.55072402648170282 142.78123543474748658 -TestParticle -1.8035383416573496085 0.31178214061844072846 38.848219271007792486 -163.78980370879801853 27.192135308956363104 240.49835213590739613 -TestParticle -1.8523952866624258107 0.2010708076570819347 22.034325231090594599 -124.711476085711595374 323.0644792551414639 138.10178915634389796 -TestParticle -1.9173340778250498317 0.2780025712872400967 25.973495130250071838 -193.9471251677579744 256.51445549034934857 68.5799795393802043 -TestParticle -1.2039954656193134763 0.32062119894339707882 11.801770668367792538 -261.58407010163364248 130.72550628237604542 295.22935271302458204 -TestParticle -1.3539793779063435952 0.05619140956045583224 0.39149769265351963554 -54.55272735280637164 335.83544373800691574 89.36258771851326799 -TestParticle -1.9516074079116982887 0.1921645005309346732 35.371640156848229708 -152.55319109406485723 247.31165449235123788 278.83909188690222436 -TestParticle -1.9301130006872968536 0.047382794904003239234 3.296738006904260665 -186.93636419954495409 38.829849755176162773 177.44532754290727894 -TestParticle -1.2580985637358546025 0.21204965723905899733 16.1659140062293325 -3.289189867948967283 190.84482276807500511 67.97050011468211039 -TestParticle -1.5295225293999865634 0.17172263806479373671 39.618093381378386653 -332.6463231490124599 278.70254383892529404 12.693771958962534185 -TestParticle -1.3231257344221201144 0.2573419902802399073 38.0841373767418645 -20.119441148442565037 244.32686028253979771 48.572638095274754733 -TestParticle -1.2390492871187110957 0.23798618359691314783 30.645766685864785472 -87.001950267678836326 278.12670273948640443 330.89492423249123476 -TestParticle -1.3993417216526349289 0.031843494342214208326 14.144935673919892594 -72.465298766095699534 334.2534597720372176 30.48791433958904662 -TestParticle -1.5347486253277040635 0.04338458251454313519 12.0921328741059639356 -120.79694902396420275 355.45117743828626544 160.7907173842522468 -TestParticle -1.2904906197620742425 0.28414011519071485923 33.037713210604835012 -289.81253890944515206 83.576357577029270374 220.09709176383933027 -TestParticle -1.6058032451228929638 0.36018141227094635504 17.994372902660266789 -3.7010845253058599624 141.54942979100397338 198.05616798418643043 -TestParticle -1.7714414500542230435 0.0035609242707668187222 22.050030319794334588 -264.59185760489833683 10.605770272399395182 215.25949766508875882 -TestParticle -1.81709217161712 0.27368429441007163794 17.149545687672187455 -35.988324614781888044 81.77856120500719328 10.201466538617181001 -TestParticle -1.9507969820486321666 0.104826252022570107214 21.570178232673107743 -110.11799658110533073 203.10615346805144554 174.54637699366600145 -TestParticle -1.5513016726876260876 0.0649073896097557973 28.406030811013923909 -294.40827400152136306 308.45384003953444108 250.69412013121518612 -TestParticle -1.6081730286462514457 0.0904772003540942199 8.756397654381963491 -95.30241023766843966 310.97856820924152998 78.51553642084900275 -TestParticle -1.9445060562513780678 0.34581412562291430346 38.93528925234138427 -322.18458452998703478 206.50871262487711988 171.6753679893202218 -TestParticle -1.2867830568980889172 0.23805020747269362014 30.605085071406584518 -107.834941188806425316 172.69897682961376972 231.64156285513004718 -TestParticle -1.5570299212666793842 0.34247490116827700168 25.701729758850273555 -57.759342054473357564 275.21368529820330195 0.5189093555138457603 -TestParticle -1.8297728730942826036 0.0059327247000139143526 26.27006410810665571 -351.91597475003959516 332.46172667657117472 193.83113607968971337 -TestParticle -1.4663451402621732189 0.019337346272064428326 0.491698998445047053 -336.79769240394642793 248.96724280968578569 175.15811073921727825 -TestParticle -1.724576194857081024 0.052697296256256631608 5.7447084496883027427 -66.182723011463494345 29.130322702617217345 339.9870439485365523 -TestParticle -1.3696669727225077029 0.33229023795273532338 39.64244722837145929 -133.49050184888841386 162.12402403598608203 293.04583577859932575 -TestParticle -1.3783417053600715008 0.2855227081254033128 11.873396199324094624 -181.03404330551020962 111.58079564001488393 50.497053185226064898 -TestParticle -1.8637392080726669086 0.0156183905360887560765 26.799919264480482894 -101.416124536033450454 141.64824974137857794 87.10767556818554169 -TestParticle -1.3990411255817394309 0.016424027824586850954 34.17231113580791657 -351.25674680067004374 51.410447621435544363 109.4743571087562799 -TestParticle -1.7113078627771947104 0.087396542572623220346 21.48366722009397023 -331.26077825265491583 87.597172428811916234 351.11237329056922363 -TestParticle -1.6537452602438895699 0.19076978286361276349 30.899468439263419128 -338.97921655361312787 354.2717007607652704 88.459659106615376345 -TestParticle -1.8713204845226436568 0.34948347966477527615 26.694021521206035885 -22.640920338079904894 267.1658484538838252 91.263466282262129425 -TestParticle -1.7800499814903345541 0.21591168642547953205 4.15893255030611364 -284.8692985786169629 273.15026927162216452 163.62920354405895296 -TestParticle -1.2770584465418410858 0.11704921307575957834 23.561299361007908004 -208.69763432291699701 114.84562071374233483 106.557589971007203644 -TestParticle -1.7789101924514278963 0.21089404756926086182 26.446391287965887784 -166.38039683220225129 280.94687192438289003 156.1732356226829097 -TestParticle -1.5095803628848272204 0.37888764670309865723 23.739638145042558648 -147.5462561757028368 320.06107890549310468 221.66365612858550094 -TestParticle -1.431320096709388201 0.090307147024224890264 8.768204975989792871 -86.741239636344801056 122.03132838806067184 343.580887072082362 -TestParticle -1.6349437899113876682 0.14387102541744481443 11.841216176535350968 -51.14042919054931957 69.171034829460595006 213.79008663660533784 -TestParticle -1.689003605562497734 0.13061345081474304286 24.749487065465949343 -180.96919715736157741 204.68845725307318162 260.67277137781871943 -TestParticle -1.3035444430147782313 0.19990048901013623972 15.958381821114077326 -24.968896817823825529 197.33820599380237581 119.001287940231961215 -TestParticle -1.6620625944290643439 0.2734543708115155236 30.556744105988030924 -323.42922129424488276 115.879900714354221236 18.69101695694187626 -TestParticle -1.9572874068027543704 0.3982637334300366816 23.395690692151514867 -282.1199835387070607 264.2819579212129497 226.80637570406867098 -TestParticle -1.7711614884940887205 0.16471476857196881705 34.541413045241888824 -209.78439563147685476 330.68687123431953978 302.79975669488345602 -TestParticle -1.2768346788945352799 0.2680189005217827325 2.3664781607185281231 -4.5230625737162633015 309.27315231219478164 35.64300138830596154 -TestParticle -1.7331467818212080712 0.08199012177664927181 2.5002689592511995187 -16.248296777956340975 8.818474849161844986 133.32825103025075464 -TestParticle -1.5824962842528258467 0.1664685697946028109 39.01047834163395578 -294.62170247515587107 5.127126749923851534 323.21555884047671725 -TestParticle -1.3065419938771187791 0.062752012732249048965 8.378519051225520542 -254.48399542766591708 227.28662992761130113 215.88914339840525258 -TestParticle -1.2803200151108913296 0.39024438031771679913 26.21206496548343523 -86.2004800657045962 86.508225331489853716 295.03587464294588472 -TestParticle -1.9599644739977994945 0.18082768987187250453 26.76260832548297941 -347.08076935823510212 187.06487585242066984 78.43547038210139988 -TestParticle -1.5504457817332411018 0.058138854268877486475 8.311304083318722391 -250.45953202370188251 51.58641776614162211 321.91182873943205323 -TestParticle -1.4030770961210228265 0.2255632436620616521 8.257376872662526068 -110.66653646497886143 331.8743125077128866 326.8827542847423615 -TestParticle -1.3330653778054313285 0.23576894818100968543 16.555280374134500931 -201.04570271621727784 304.9737571038722308 129.38177632189641031 -TestParticle -1.4676189305416613706 0.15334509742223720319 29.730324421851861416 -93.28877448580836074 98.24809064509591394 318.26221325804715434 -TestParticle -1.4959613849179316247 0.26490707510895572518 8.435591899110246317 -121.44478123997235741 352.46125426578402084 269.21443204906552182 -TestParticle -1.2410245922213516412 0.16484650483123386433 29.036807003172221187 -234.59702065989810649 212.29149699166657683 309.02229933747048563 -TestParticle -1.2104445735427551423 0.27493160452164350227 31.472614096909531156 -172.8652728002631136 303.96742459461654562 8.009940254088059319 -TestParticle -1.8791733750261010449 0.2587599416761243165 30.401845910812088647 -330.1151954343364423 190.20401433347646503 104.67843668270934643 -TestParticle -1.3013630074517779089 0.22413535954031660324 32.01650674239483152 -63.549710245898353378 35.89931403059021875 158.56811223007159128 -TestParticle -1.9547724398089645348 0.0786294356900830993 10.0598953139010802715 -69.4839845505388638 123.32244013516246639 31.421777442531322322 -TestParticle -1.6120256585797529958 0.19985700875898035345 13.999189942348966298 -78.857222386685961624 349.6556927780835622 58.475688092723309808 -TestParticle -1.7578912848822172421 0.27207852440462437782 21.16570903311817986 -204.48739950618715966 68.64871257741852162 227.95088374477833781 -TestParticle -1.8170356771723037426 0.24230078833019122464 19.368483713748780417 -184.73419610737784069 272.32723488431577152 126.891658495766833425 -TestParticle -1.8561231261283124283 0.19157748016708203709 1.1886704509024781373 -254.2676067727032887 317.6217024209003057 224.34445674903426493 -TestParticle -1.9710622679246994071 0.14623926742902368381 6.640292860769481109 -190.41063402021279671 187.773358994985756 328.47417804669458974 -TestParticle -1.8390376809348407683 0.39004880820775639227 20.066519467297950996 -211.93199248227401199 289.47815944254944043 137.15839269809171697 -TestParticle -1.6111502808558577637 0.22394676788626455277 20.061937046580968769 -92.54520491825057604 92.01310424807805077 13.375630065565452753 -TestParticle -1.7289359898596003973 0.029780688540387692531 26.014739049810341243 -312.66680607544742543 228.17665637399315415 125.22825394003517374 -TestParticle -1.2705682146072982963 0.029404610289824398284 5.561963728286389852 -84.16555574179947996 331.08838136349748993 315.88331119433712502 -TestParticle -1.8573347647002547145 0.36089888274309028793 33.45261607330014897 -108.58851164869084016 217.00073148209528995 139.41678117547121474 -TestParticle -1.5119662840275136517 0.035019622195022657996 10.463315222301648788 -152.85193304965602579 42.895445465204801394 38.742869188454783114 -TestParticle -1.7622884149632529471 0.03162410217369809179 3.1822974384423297067 -37.26277315140376345 107.89474442992022318 186.6015285726906825 -TestParticle -1.3516643515537363207 0.00042846679844568138443 14.013484979190140578 -216.76556913128737847 329.5425274371341402 157.99664633404185565 -TestParticle -1.3725976866577220825 0.30646538230027742244 11.329739671767651288 -198.97848141965863533 44.651190190469009167 28.049566579775078168 -TestParticle -1.4591070353626824918 0.08119659950059535114 34.28551752565069677 -306.99758279574081143 104.56005980026995417 24.491183217056139654 -TestParticle -1.6809883631745992094 0.12405907090243922797 23.088918298866115464 -81.89324756024211638 45.486408290411304733 5.9086829848113620045 -TestParticle -1.3535618238311779571 0.11072994226846155641 6.1365791065780417313 -96.5917090856876257 125.77992141224173395 180.26956152431557712 -TestParticle -1.5024996182012646528 0.2601294541852439135 20.11839589454453403 -270.4000045350792334 353.011762488246859 34.641037025004784766 -TestParticle -1.5996488376502526751 0.37889391086596613256 18.528995245881297649 -215.86591794372824893 196.33677334782890966 20.482598606365485239 -TestParticle -1.7931356901400370418 0.025945290910749509855 26.661454696830183764 -188.02499061598265939 217.74613305793528184 352.64512058062791766 -TestParticle -1.6808120166727305023 0.26627765088552390882 4.4798421923713638293 -12.471177251742290082 9.432555892002669751 336.72507040011447543 -TestParticle -1.6313081817828176678 0.0086570580622717507174 3.9083339029362873518 -54.248103250365730332 318.7038881970888724 331.85368591582181352 -TestParticle -1.2884450142579531029 0.1681046156164187344 35.34871223758726444 -240.5583121923978922 135.24748641897326706 301.64571007267852565 -TestParticle -1.9196539088974737819 0.055293464951134657648 39.174420254686374676 -13.003093109260595028 224.19261478871260351 272.9340647583842383 -TestParticle -1.3704960962475472019 0.11179773250371188853 23.81208520955706831 -261.70166394043076252 10.650163480395606896 96.095112534597603826 -TestParticle -1.9516781167723931123 0.20402034023295062548 32.535249468476067136 -340.51354688545097815 329.0040653030519593 109.98356406041511946 -TestParticle -1.8140222569343318337 0.12613518245266175377 1.4950171510413001741 -234.61793333937521311 320.05130111528796988 172.88154495883503614 -TestParticle -1.8102010682471065817 0.14811926068150899072 0.47152065059882453113 -231.56413706767099825 205.2503541540525589 214.7508917825621495 -TestParticle -1.3323729215149744398 0.19959213905409678436 1.3073421511548932727 -151.66443112411295147 341.31892085633529632 144.25232896171203834 -TestParticle -1.2204541150545651362 0.068668187712776870835 4.014281498324958619 -174.08147891950491726 47.939506002741296697 254.99017431971773817 -TestParticle -1.2181192459350491664 0.025059093817326606735 7.204862413525972009 -48.60770716273837877 329.11947000106135874 217.6643233891191187 -TestParticle -1.6039675062130638317 0.35797604454305875787 16.056969103103426733 -87.92417372221831329 49.76521958624503128 164.99398402032807098 -TestParticle -1.8725342069546249135 0.106279250804296898636 0.45718402173144045975 -119.596726134790174 107.86697924451233632 232.81352842822093407 -TestParticle -1.7853111973976689697 0.12193477571081268174 3.680789884957089697 -205.60326749430927862 40.207082764860338386 289.2290546833312419 -TestParticle -1.417950447978111761 0.24357413812980258094 1.910476157584461987 -252.61262373556786542 355.48333419302929315 151.32407206005677835 -TestParticle -1.2280461512973894767 0.15278421763439650749 26.714312283832946093 -142.72673485719965925 232.69712275301176874 346.3375478502677538 -TestParticle -1.61151127031616892 0.3744225370958842447 36.56793088861800811 -328.09520081336302155 25.920977978027824662 288.72452391776596414 -TestParticle -1.2239475600090146123 0.24714055634484358159 30.304522847333871027 -52.68180217169934565 356.99734588216864495 56.617981510557434888 -TestParticle -1.2496667763539286433 0.29747468986797759305 21.37154433932160913 -209.20331717962355356 22.663460638340339415 243.0475686976612053 -TestParticle -1.3767605238800932899 0.16005520292207792155 6.1854407103408437507 -301.0924331535983356 324.9040368073589775 194.17256664039328484 -TestParticle -1.2487797979186712194 0.16488755850697139893 27.605925256805747381 -173.22312758245544728 239.01695963206066153 175.97057379774636843 -TestParticle -1.2254722592225348876 0.36803675574552041638 17.169692704564543106 -198.47031096951334916 278.36167082537872375 125.492714298233096315 -TestParticle -1.6464965033862297705 0.1517233377674910566 13.532163365202411143 -147.08019388518567894 177.40254091222027455 340.04568453953692142 -TestParticle -1.2241673144222895431 0.1378443050280294957 35.034429639418924296 -279.5154571951889011 236.88366494050367805 224.20218590463449004 -TestParticle -1.7054405098540872388 0.3610118405579151868 11.466405393735001894 -354.5918155292421261 347.1596768668937898 219.93975816420154956 -TestParticle -1.7400094098497860262 0.11768201787113397039 3.0207223829180174235 -344.79550555000747636 295.17286383856117027 107.65817940211057646 -TestParticle -1.4518563888365596526 0.034369934761878086216 5.703231914559241389 -123.995036213356954136 112.321809800044363215 96.308678475290903975 -TestParticle -1.2222379634093671896 0.14278765376770935491 35.361595327244465636 -315.14729198154049072 321.37175810105372875 262.59992588280709924 -TestParticle -1.2388409450815878188 0.29191544705043231955 14.574148472908646568 -354.52890314367516567 301.2116870378684439 101.6607227628783221 -TestParticle -1.2004854536116522645 0.31759418786438237126 35.64893550976294989 -150.1713542262849046 263.81583006909363576 352.70617164487305217 -TestParticle -1.9942890442362894987 0.19536136516905414084 35.02451517807598691 -125.959361711604387324 266.3424034858336995 225.8398826035477498 -TestParticle -1.5915447637460526931 0.0895260552791858899 24.02901618574255238 -322.40268348510250007 115.71588659763698104 232.13880147735969217 -TestParticle -1.8790673483459361393 0.17433764017862168894 13.878215826572342095 -302.39495868122469346 259.03939837677381774 176.29569985086394013 -TestParticle -1.9699962554990502195 0.38438649317544010264 36.886012906803621547 -71.57770428256088735 76.46325818263683516 152.99488881347215852 -TestParticle -1.9815372834826587845 0.17262153411198999375 2.83353778898145503 -239.37167896200179484 354.1664112035709877 298.12866718881934958 -TestParticle -1.8155595191765212526 0.00946228278143057544 38.64106328673518931 -83.00268912398927057 67.39652732514183242 195.80213873516331091 -TestParticle -1.8868581896910789908 0.10440835820682173307 15.007174114646065988 -3.363490125056509683 163.21113577536885941 277.4874262071848534 -TestParticle -1.5619200947925855338 0.0059432103700412857936 28.417160713316764742 -199.61588156187738718 146.61610611302111806 239.63331133984317489 -TestParticle -1.5212478213877396183 0.39927753429172280208 20.482036387314252579 -328.51885419136107203 7.1256709736876455707 220.89114467811927511 -TestParticle -1.8571870020289564795 0.091291230530104086616 5.8118062401183578913 -90.75198382995706936 192.24228564818409382 97.133874093047666065 -TestParticle -1.9171289936627273764 0.15261088480197210204 38.10675746822411014 -307.07749448841616413 355.13520879558041088 42.711583491490678455 -TestParticle -1.7364144307839262105 0.212129283201967056 18.744823342299753222 -23.928680492317099038 37.437700592246308418 64.10777424122947821 -TestParticle -1.615801582218067356 0.15507189040762445198 5.289237911360147315 -2.9760090649453463385 170.77756092233224194 126.74171547116436898 -TestParticle -1.3071905708698117188 0.34127930871062794882 17.996264880013068677 -181.87012353589301483 211.32152679731703415 284.19737442691894103 -TestParticle -1.2265401930807908748 0.25798059801133454982 34.025699672304931198 -87.484085061199664324 233.26336671618474838 310.39211945198593412 -TestParticle -1.2051260378681512009 0.3069049294618042545 37.351493484362229935 -114.521127203859620636 225.6531083956228656 323.1220799515929798 -TestParticle -1.8334732437656884318 0.37979115889431414033 14.226342594064389502 -331.7883640504541063 109.06927231695421199 144.65450510058425948 -TestParticle -1.757300956926634683 0.03414936250768385584 23.912004140762192606 -322.3724083824729405 134.91275424426311247 171.32647169967813738 -TestParticle -1.8972253261023601656 0.35656552318718498507 28.47629514891832514 -321.29937216619140372 70.71608626545858556 213.57910706058532924 -TestParticle -1.9917616839747163127 0.32376104104249381344 8.91181936527569718 -200.88415597368361887 23.513470382909822831 100.72835347725671795 -TestParticle -1.6165777777920147251 0.32043762073249004718 16.726392824188689445 -319.72153811597894446 76.78830327849077264 138.42254101919101572 -TestParticle -1.8908331674281746437 0.045197492899151252288 1.3383682043347544521 -312.10875470237436957 307.494732749847401 43.074246036675127414 -TestParticle -1.2145287335503922588 0.18257617394552527745 31.629727041908243024 -3.7714421582542145828 327.9557064611080932 329.9790680610109348 -TestParticle -1.8625485962061800738 0.24850308301344462003 2.0061095060140976543 -276.90239618431269264 350.88215248164351578 348.2932770314767481 -TestParticle -1.7953658240966166026 0.23860504712104810277 30.564301023692120651 -268.6736542028508552 254.54176920249031468 269.62615941325310587 -TestParticle -1.8519636256102920413 0.13630536382454808142 25.429742406638986552 -78.06201903944463538 183.89412111638756642 25.670444097748280399 -TestParticle -1.9912586036233026476 0.0062934836627138949355 3.9866901191125192483 -353.92558378078365422 121.86076402069599567 272.13181013382109086 -TestParticle -1.2352461280314077641 0.13108872108404742707 2.4473753819670784893 -223.0667681463768588 134.42147854096177184 161.85468044136672461 -TestParticle -1.3431819133091436047 0.28681705477285673878 22.82513974594832007 -232.7183120134940566 120.199688171678360504 89.77367022064561297 -TestParticle -1.8403545873570172908 0.24879279733973019839 4.0287923881425502515 -15.018525270146003692 85.179302481017629134 62.783331763645470858 -TestParticle -1.381867054141263651 0.041622600218831219687 20.582798332241445394 -16.94221565894110526 117.67293863884100347 301.82514806956680786 -TestParticle -1.8641683600359446604 0.24640721081737218534 5.9107924107914655565 -193.20103651885807494 44.2323469313580091 26.743437036080784708 -TestParticle -1.966054790276180464 0.2690464178872462031 14.878455955491389773 -190.60763663869553852 31.588470897177995056 100.366806653161106055 -TestParticle -1.6058040413293108717 0.29951736276665757996 32.261171438174280013 -128.57574732488706104 32.785220122308132318 5.815690987139072732 -TestParticle -1.6218958057245982385 0.20051601410731448305 35.228407716619500434 -275.05072744657877593 300.36353903970075407 137.58872709072204543 -TestParticle -1.9766063717976680714 0.39029116187457174592 35.936563690886423217 -276.4677919812604614 334.4193480382128314 74.17428380404710708 -TestParticle -1.4924898153539933876 0.12959279079593266637 39.497773315041648345 -306.13052013355064673 297.98869981653200512 134.11781736074624405 -TestParticle -1.8353633188339963933 0.019510947086492525654 35.474352018859882207 -260.37806171878622763 151.50200809864463736 309.73656114784841975 -TestParticle -1.6024488136145134121 0.027272421536337843745 28.531535673798313013 -11.154644928392061232 313.60248630627489774 220.0912732804740699 -TestParticle -1.4120513432815475774 0.29969768596351453738 17.02938110092897972 -269.20328072337844105 42.08893931076963213 126.58679602124011865 -TestParticle -1.7381168022087705172 0.29181610891675680008 0.578376627518526476 -102.38820556898792802 176.55332025897169501 164.93491360823296077 -TestParticle -1.651697945678905155 0.10215579780054198644 29.466376982324295142 -118.66030632495935038 355.77634853151920424 138.86820482744579408 -TestParticle -1.8964095997568284346 0.14855799694311630499 39.315092089557069244 -66.7203702634703717 109.12901978076088483 150.07738642659984407 -TestParticle -1.5884778821144036609 0.34804404474317385265 8.230716828452404599 -238.65003666711348274 19.561503330036060788 172.3300970659766449 -TestParticle -1.4852533118509871901 0.14921150930008680868 19.72836045372870828 -214.04378603222667721 162.09311096493223658 74.70412564882457218 -TestParticle -1.3995786109265431207 0.2170751900351963748 5.6353499706781517986 -136.77890520256397622 41.74190372493747958 352.76491235469808316 -TestParticle -1.9228837399064100389 0.20666458127164555325 31.918474396874408683 -25.57157805855647581 146.61033704579944015 124.85803020390667939 -TestParticle -1.5491200767868975596 0.37703244317878858993 5.088593545490081027 -38.820500192778638393 121.37946795513649079 24.303500272632902579 -TestParticle -1.6942853977776144436 0.090260172320617615416 25.30769952267446854 -161.30886094388631591 116.98046667590497805 38.286029141363265182 -TestParticle -1.6090251866675413517 0.330322662148613444 9.770748848728519675 -263.0814719840412863 130.26024091675910199 286.9327501208536546 -TestParticle -1.9761336997553433648 0.2926123710566602143 11.274914096097191418 -332.1701813530870595 307.94382558508260672 353.807211256272808 -TestParticle -1.9968906969927759931 0.3233230682542853618 26.00314542561351061 -79.80693890771757992 308.2283099476609891 243.34005704939397674 -TestParticle -1.8031947344086236562 0.14995127116151910074 1.730342239053141995 -348.6351290160268377 154.3487630625562872 28.463371915640660603 -TestParticle -1.8395166633814701296 0.3354540599588180516 22.093131712634573205 -86.610640388957989444 239.4548535151652402 312.24619268529380633 -TestParticle -1.3629305527230259898 0.2099232743767838194 30.216497531918712127 -102.43196923936434928 291.32106047341460453 2.1370626980559981334 -TestParticle -1.7455726368986721475 0.026854653926422458743 3.5759919284920771432 -354.23018906949636175 218.20031690429203763 328.7114242710409826 -TestParticle -1.8154807930100198554 0.38785895954054117052 30.190244155261783732 -84.158791911543673336 145.33493614486761203 216.44848876198116727 -TestParticle -1.6499702946012431148 0.38233820338992924315 13.614607279413908358 -33.87451574095803153 90.770300669062208954 180.38849672518907141 -TestParticle -1.607515534627930176 0.059816004314718410062 35.188867073591850954 -58.61309722228839547 253.79649442362003242 91.30583916434224534 -TestParticle -1.9899983350379286673 0.30667218968608733753 39.83983478820580615 -209.92012615445401025 242.81573248914770602 7.221381167673248669 -TestParticle -1.5778501251334575706 0.11118331397677137795 37.590979480700937643 -345.16243909883007746 9.645072368649788785 50.426633047687808187 -TestParticle -1.8837383001263663385 0.20673789324487820696 21.972954461156501083 -78.99100998693006659 24.805859834858065227 136.69965104577451598 -TestParticle -1.8299552552499931402 0.18024309648678646378 33.71418287836082328 -287.1584786318022111 76.47733005592756683 216.63675723929046057 -TestParticle -1.8307526657330810416 0.27679256938591745296 14.42019596286409211 -147.28115682985833246 236.20842913390856666 70.36203841533576053 -TestParticle -1.7619978997528076281 0.014257923627121950327 18.454020582426768016 -275.7628626446463045 152.24331061485040095 103.04339508992384822 -TestParticle -1.2611641121223651218 0.2092199031608525106 17.779518579686019564 -102.7504319389703511 6.548313747168017507 140.31125376249352144 -TestParticle -1.7663975820756958601 0.25859601590736014387 19.29766354922654159 -228.43411110252168328 129.52408847472079856 44.31277736443019677 -TestParticle -1.3455298896696588073 0.051640741433284009787 36.190409530870716992 -63.492703118667094486 178.32472671129730202 219.22272979662204762 -TestParticle -1.8502619397752217978 0.016055258128672856427 24.72292322260771158 -280.24156788062276746 1.0103622910431475646 89.91460784296667441 -TestParticle -1.7394822607661057923 0.13625236700994178274 8.773342269773106494 -131.40116141700701746 79.224373058834927974 282.8109557650995498 -TestParticle -1.6325195629104731765 0.16262358056449152666 8.946438635142083484 -196.95655091099223455 13.582007343579313385 258.10561033792743046 -TestParticle -1.7657479077259037314 0.21823895457628741945 26.194016006374575056 -307.4759621278849977 98.40357006941655982 64.08127327032266862 -TestParticle -1.3184659717472237972 0.20902078438144011674 11.194180638539418027 -209.8144125213535176 233.63319375255508703 171.85375675646986338 -TestParticle -1.6265974791221389228 0.3412246124964996019 31.920108006714791316 -47.471005836654683208 293.97130420183299293 294.00277926085681202 -TestParticle -1.544562457381803755 0.26456236803106419897 16.966290843319804083 -53.617851002077699718 23.906897211735604003 172.46215455198040445 -TestParticle -1.8302658298265410686 0.016558573352333152279 23.88277176507106958 -160.31985284355113208 24.957240748542652398 126.6630513998358083 -TestParticle -1.6333356556090419254 0.25338625439533907224 11.051395862722980468 -182.26698944663951352 1.9926145156870767039 206.81766326774084064 -TestParticle -1.2674061997735568408 0.09083958911004344494 16.414033820600888447 -209.7777498397578313 350.73333597951523188 247.44407246182404947 -TestParticle -1.400118114272113079 0.16683948053104513676 27.357400210939808005 -107.57418681944162131 96.46599300991492498 351.137614793950263 -TestParticle -1.542911801971112773 0.22704910395233757203 35.542775761322914718 -183.89056710921508397 326.93869125935344755 108.004775809479497184 -TestParticle -1.8076126800363871983 0.3514591336111956288 31.06364189291468847 -32.09942049648420692 328.34181095498098557 23.785841162187210784 -TestParticle -1.7657364621109161718 0.22171357606490707526 37.37986273837123008 -76.229451450918475075 186.15095789038804241 272.82850857627113328 -TestParticle -1.5339591135633763308 0.14194102156165430695 16.888317976342129612 -130.44976850069960506 252.36020783978619875 120.456187175611859175 -TestParticle -1.9547780848567972711 0.20899592311387996113 28.868044731219395516 -228.48529363010104021 342.5481929867736426 287.9707078087696459 -TestParticle -1.2418423098941544502 0.2626072565929837288 2.1074243271891202056 -38.080338719023941962 119.27817821310316049 12.056891938029119515 -TestParticle -1.2210546528534078625 0.3775561742151631872 22.111051712315155982 -338.55211294801040367 12.980519500186410653 332.2853401701941607 -TestParticle -1.5963937431999124517 0.23239324239635986147 13.194381854516867847 -58.007673822576016676 88.15306827351753327 155.81366075873469867 -TestParticle -1.5786275082915319778 0.025562551186680871479 4.998454237047265103 -250.39244849302215812 165.61747690949906087 149.37807874408460407 -TestParticle -1.6098684422151645634 0.21941479472017652586 38.283886043658093 -237.71100658433758213 47.01387761056833625 340.9146849041053997 -TestParticle -1.294274143429140933 0.3692138815235402327 37.966030890732696434 -203.45477640609851733 296.29180039237496658 44.323085276308532343 -TestParticle -1.5889819356899443914 0.084869830381732264124 1.0823445911213003257 -301.3291216497269147 146.81272157061789585 2.2993592847625343722 -TestParticle -1.495972566018333838 0.2617122471497527747 13.094048981160977263 -112.72021003020111607 127.77611875010921949 296.87288781423353612 -TestParticle -1.9818950278621338956 0.30723187525460954328 2.2340086246482782073 -253.14761844363803789 165.37409022827591798 191.3408807414710111 -TestParticle -1.7869956116636900312 0.045787597413756889186 8.90426427671208387 -227.8168631112827427 149.58799389390406986 24.858909708161100127 -TestParticle -1.9448897771198014883 0.05694944930378804948 36.311102677736613487 -84.3756745725393813 14.735521995724774058 314.16923571788140634 -TestParticle -1.5778886440600849994 0.054612245238724765883 16.72994958727242576 -293.0541083071825028 260.48271034952341552 308.15802194547808313 -TestParticle -1.3022587146281570103 0.26839233124203137892 18.02838057643581493 -293.20763835009915965 312.4703557364094877 106.58503108046902241 -TestParticle -1.8428500612922003032 0.23594727253001890332 11.315478566151577766 -9.262284156503813648 11.174441070760416039 331.91331034768620611 -TestParticle -1.2400313949450130213 0.37422492957960290516 16.60903446615966672 -240.33042266148279964 153.97322107823731585 191.41559045744850209 -TestParticle -1.9829274684920319416 0.3634611481375451536 25.819601695264427832 -140.99742244780588862 341.49734482956387183 8.731842495851447339 -TestParticle -1.9975413987753882772 0.06592938413948253029 39.49276861893206103 -67.714562888696974596 98.14914061512281762 45.19626721853934015 -TestParticle -1.2436383625451867818 0.3204615517738288455 26.461603913930925813 -266.5125426106603186 127.50909218237357834 0.3132830361456928614 -TestParticle -1.4113215699552892346 0.009827894395237192146 37.858626352737367426 -253.23691224458718807 108.52674294880429784 352.47828245113328194 -TestParticle -1.8148473149676069838 0.017705697189401049807 27.03434752366788274 -244.97100671505916125 96.848173936006702434 232.97923224763914618 -TestParticle -1.8212512693609279602 0.27211932176121911287 4.7578666520375545446 -347.57353058021692505 254.19838041200335965 6.6604121361125034895 -TestParticle -1.6430443076417013959 0.042365150738876616865 28.313700526240026534 -178.6338948507659552 287.94750707892865194 146.775946581025039 -TestParticle -1.2047662238103988841 0.23251833898522478172 17.70944339203029827 -282.07165060128687628 43.193800331112015556 189.58232124886598058 -TestParticle -1.2467705317577537638 0.29356902400030004952 2.8706191725519047964 -242.4004033144470327 28.806681869090574821 296.21360336099968436 -TestParticle -1.3162696178512978129 0.30749173225083181737 9.346008763094072691 -322.38053647407821245 112.34526406313270286 132.09084683753127365 -TestParticle -1.2971409174950825349 0.3376994788613812415 24.652899562822732094 -299.7803539105363484 271.40817959188655095 266.8572235615602608 -TestParticle -1.7684747977650516759 0.02661749740193952718 10.096507324045376208 -3.7221406213358587678 125.36494422546940086 238.11022628505401144 -TestParticle -1.8562458518793771844 0.077017667000931988586 8.7143363020037831745 -136.69548804548151111 320.94977656886021578 128.10172157330882214 -TestParticle -1.5044816034257817439 0.21762930629061374987 27.505997823490588416 -123.58136898241176027 187.9229325893226985 113.043904522795230605 -TestParticle -1.7868133877825629341 0.008087932404090647162 23.413784625415864582 -218.89711766597091014 88.56442540385896223 208.43834176513581724 -TestParticle -1.9402143213090712326 0.14949494785208861103 26.511808095563488052 -107.604663311176523166 130.69889435502176411 346.87469017336604793 -TestParticle -1.5966683044291980487 0.087101617604941061757 35.919427778579809285 -212.8714684966646189 289.47277777746671745 150.30140968266374557 -TestParticle -1.5311077130660335488 0.006686025386596972271 2.6738949911861054076 -164.51009812173990099 316.04513748492058767 258.44750388729431734 -TestParticle -1.327174430660648996 0.16386649979480424899 29.516591637239059764 -42.47034129892313814 297.69030488053482486 179.48650722792217493 -TestParticle -1.3309285665414212207 0.31056216374123679635 33.20416058697580297 -182.12327311281021025 179.4712707903883313 47.404071121072391293 -TestParticle -1.2695626979113197041 0.028739588397623319627 34.7510196296938787 -156.66911337647667324 15.489917584647256987 137.9360720619328049 -TestParticle -1.961564416777008768 0.38198101311209609054 20.407128195470789933 -116.450533784431996764 317.3401517067230202 183.14633665136960872 -TestParticle -1.5940513845582582331 0.25613384894831064953 29.533539385317940429 -118.85654306899444066 250.92868906503659332 22.448371873007765487 -TestParticle -1.8442908242187292522 0.19455300058304564326 38.64468812151265098 -327.51192512776293597 261.15575066638751878 220.98151223015130995 -TestParticle -1.9551136736888132805 0.05881060116092867024 0.025983316883650964257 -229.51441899139550173 217.59860795663826138 108.775137355673251705 -TestParticle -1.3586578999851930405 0.34983150673028151623 31.522812174550345787 -105.68138198042714748 123.58623362447058014 40.330126317320825535 -TestParticle -1.902888826244875764 0.13683561730200419215 16.275257623666469442 -105.98161437435868493 148.2954616585051042 301.45848496238744474 -TestParticle -1.4388714351119729074 0.12902603848379340379 21.287394563627660915 -197.02123109899764586 352.44807359808243064 351.33034912544712824 -TestParticle -1.6931112006676685144 0.013916379702603532201 0.7871365555378062595 -188.64764325380838272 181.38199447667832942 29.813972851285797105 -TestParticle -1.6449616174898105125 0.0310490777007133463 9.657476944838542465 -333.95122687579464582 342.1511167418379955 160.69927097810261785 -TestParticle -1.432310913839848876 0.006987746683723328363 32.61241995358341228 -207.28809337462874396 169.31652720575732474 255.68956575096319739 -TestParticle -1.7327468488118134005 0.03857017036911090241 17.468015575192744393 -143.82903277012908916 99.60548209763706495 166.68173997089294858 -TestParticle -1.5512315858530165702 0.17035757433763087931 28.229428870918749084 -211.42236583345217582 136.37631347760083145 126.78807511085641124 -TestParticle -1.5128716646861577466 0.25892751799964647264 10.396770119409808331 -251.02700694813202631 225.21225462676682127 190.02303419914397864 -TestParticle -1.3509296764855895923 0.19460583033279599263 25.473407765343523579 -153.07999025709941066 160.34541100643662048 39.661129674485906094 -TestParticle -1.6995982689149604639 0.3683946534553529384 13.407331577384432819 -340.26004127001408506 272.0620153240722061 254.6289696923701058 -TestParticle -1.4262589721598459835 0.39380044551624404647 22.273999686412832233 -126.6676609334621304 343.6417878124360641 356.69746962842407356 -TestParticle -1.3261721625529891977 0.39678878113200655164 4.2056417606931040254 -238.10434769519417841 155.06469638647084253 44.875703119243368633 -TestParticle -1.9576977154420573957 0.26084185228864192885 4.55948470669549355 -190.48438127706978662 33.209683105017965943 111.270270586090106235 -TestParticle -1.8552016088932457016 0.13548857795579999364 39.778098090381654117 -36.82048012699509343 277.63542496441021967 284.2017295471840157 -TestParticle -1.6904488396185337606 0.10545628795963413182 32.08178306599211993 -75.246216623590498784 230.69409080017558722 202.52540071832260082 -TestParticle -1.8262524413841534354 0.33415074562628183097 12.176323543258451565 -135.12569593248673527 273.69848190668875532 306.5447498396289916 diff --git a/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_param.in b/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_param.in deleted file mode 100644 index ba1fb3c2b..000000000 --- a/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_param.in +++ /dev/null @@ -1,38 +0,0 @@ -! VERSION Swiftest parameter input -T0 0.0 -TSTOP 200000000.0 -DT 0.005 -ISTEP_OUT 200000 -ISTEP_DUMP 200000 -OUT_FORM XVEL -OUT_TYPE NETCDF_DOUBLE -OUT_STAT REPLACE -IN_TYPE ASCII -PL_IN hungarias_5pl_500tp_17_pl.in -TP_IN hungarias_5pl_500tp_17_tp.in -CB_IN hungarias_5pl_500tp_17_sun_MsunAUYR.in -BIN_OUT hungarias_5pl_500tp_17_out.nc -CHK_QMIN -1.0 -CHK_RMIN -1.0 -CHK_RMAX 1000.0 -CHK_EJECT 1000.0 -CHK_QMIN_COORD HELIO -CHK_QMIN_RANGE -1.0 -1.0 -MU2KG 1.988409870698051e+30 -TU2S 31557600.0 -DU2M 149597870700.0 -IN_FORM EL -EXTRA_FORCE NO -PARTICLE_OUT hungarias_5pl_500tp_17_particle.dat -BIG_DISCARD NO -CHK_CLOSE YES -RHILL_PRESENT YES -FRAGMENTATION NO -ROTATION YES -TIDES NO -ENERGY YES -GR YES -INTERACTION_LOOPS ADAPTIVE -ENCOUNTER_CHECK ADAPTIVE -ENERGY_OUT hungarias_5pl_500tp_17_energy.dat -GMTINY 3.646098141953443043e-08 diff --git a/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_pl.in b/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_pl.in deleted file mode 100644 index 8f4ffd063..000000000 --- a/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_pl.in +++ /dev/null @@ -1,79 +0,0 @@ -13 -Mercury 6.553709809565314146e-06 0.0014751274117575772341 -1.6306381826061645943e-05 -0.38709894990924181846 0.20562369687869339052 7.0036069691825035832 -48.302897646473702764 29.190213908309409874 163.69992642152809026 -0.0 0.0 0.34599999999999997424 -3.5735549824428292985 -18.380047749494480457 34.361526740492798437 -Venus 9.6633133995815381836e-05 0.006759122875155079725 -4.0453784346544178454e-05 -0.7233300630551103838 0.006773384545514573099 3.394505355540899938 -76.62090440289564697 55.183156101464518883 271.2285045598760007 -0.0 0.0 0.4000000000000000222 -0.17650282045605921225 -3.6612475825356215592 8.702866268072763821 -Earth 0.000120026935827952456416 0.010044657392872289059 -4.25875607065040958e-05 -0.99999328599172943033 0.01668004783869252855 0.0027793940989077428085 -175.84932558359508903 287.2227751976308241 324.72725799674782365 -0.0 0.0 0.33069999999999999396 -4.827962479462605839 0.034731626640621778608 2301.2114260455621944 -Mars 1.2739802010675941808e-05 0.007246146587933918669 -2.265740805092889601e-05 -1.5236121180553410248 0.093387475645674775104 1.8479297186242829021 -49.490271729763087194 286.7387645553690163 252.78317601821959215 -0.0 0.0 0.3644000000000000017 -997.9376283354346323 -909.38573894978675416 1783.4600697011568969 -Jupiter 0.03769225108898567778 0.35525381666404283465 -0.00046732617030490929307 -5.203268729924161562 0.04848413524543258163 1.3035624911873560094 -100.51639734596980702 273.421918018626684 325.351028522703416 -0.0 0.0 0.27560000000000001164 --80.967241888586720104 -2387.9998942634933492 5008.7344122962876782 -Saturn 0.01128589982009127331 0.43764770913411007376 -0.00038925687730393611812 -9.581513697274186114 0.05248801962394190196 2.4862838811768979141 -113.59546767797320399 335.45662431368151601 228.84653123700309152 -0.0 0.0 0.22000000000000000111 -441.9323685947327233 378.52918410105413535 5135.911248678291292 -Uranus 0.001723658947826773068 0.4699394560146697986 -0.00016953449859497231466 -19.24773626798451076 0.04408736292912442123 0.7704474968533898682 -74.09072726634606454 95.12631113857929677 237.66915583105441101 -0.0 0.0 0.23000000000000000999 --677.3000258209181323 -3008.109907190578637 -836.301326618569835 -Neptune 0.0020336100526728302882 0.7816500366521773358 -0.000164587904124493665 -30.297815841143489024 0.013873050398302080172 1.7688477929856469828 -131.74107055888509876 246.83916166351488641 334.07963351871291025 -0.0 0.0 0.23000000000000000999 -1231.0256802954641403 -2178.2009371051150557 2329.6179923847095223 -Planetesimal 3.646098141953443043e-07 0.0021579178542993813182 -7.585803886728505278e-06 -1.4833614415692299993 0.22741315975763076729 31.813233836229972695 -353.17976431207927135 140.04791609627329763 276.36980676609317698 -0.4000000000000000222 0.4000000000000000222 0.4000000000000000222 -0.0 0.0 0.0 -Planetesimal 3.646098141953443043e-07 0.0023146091557723819966 -7.585803886728505278e-06 -1.591071674547404724 0.20226306525263618163 1.0591008596928608299 -174.06697724512676473 335.3163306230074454 223.56527105994337035 -0.4000000000000000222 0.4000000000000000222 0.4000000000000000222 -0.0 0.0 0.0 -Planetesimal 3.646098141953443043e-07 0.0022981274462569030274 -7.585803886728505278e-06 -1.5797420809126441199 0.24741174618562222776 29.534567106616030685 -344.82468258123401483 161.14487195055056645 152.5251306953267374 -0.4000000000000000222 0.4000000000000000222 0.4000000000000000222 -0.0 0.0 0.0 -Planetesimal 3.646098141953443043e-07 0.0023375315639560956954 -7.585803886728505278e-06 -1.6068286304388843533 0.28919101512899575424 7.37565965800404566 -336.92026211210111342 206.23395515463789707 358.94392598114910697 -0.4000000000000000222 0.4000000000000000222 0.4000000000000000222 -0.0 0.0 0.0 -Planetesimal 3.646098141953443043e-07 0.0021752159010438748034 -7.585803886728505278e-06 -1.4952521887096372755 0.07630357603197107652 15.560677329970133087 -226.73360615217720238 40.68010911926434403 329.55798685742456655 -0.4000000000000000222 0.4000000000000000222 0.4000000000000000222 -0.0 0.0 0.0 diff --git a/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_sun_MsunAUYR.in b/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_sun_MsunAUYR.in deleted file mode 100644 index b2cb85c35..000000000 --- a/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_sun_MsunAUYR.in +++ /dev/null @@ -1,7 +0,0 @@ -Sun -39.476926408897626 -0.004650467260962157 -4.7535806948127355e-12 --2.2473967953572827e-18 -0.0 0.0 0.07 -11.209306302144773 -38.759372036774764 82.25088158389266 diff --git a/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_tp.in b/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_tp.in deleted file mode 100644 index 573541ac9..000000000 --- a/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_tp.in +++ /dev/null @@ -1 +0,0 @@ -0 diff --git a/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_param.in b/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_param.in deleted file mode 100644 index ba1fb3c2b..000000000 --- a/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_param.in +++ /dev/null @@ -1,38 +0,0 @@ -! VERSION Swiftest parameter input -T0 0.0 -TSTOP 200000000.0 -DT 0.005 -ISTEP_OUT 200000 -ISTEP_DUMP 200000 -OUT_FORM XVEL -OUT_TYPE NETCDF_DOUBLE -OUT_STAT REPLACE -IN_TYPE ASCII -PL_IN hungarias_5pl_500tp_17_pl.in -TP_IN hungarias_5pl_500tp_17_tp.in -CB_IN hungarias_5pl_500tp_17_sun_MsunAUYR.in -BIN_OUT hungarias_5pl_500tp_17_out.nc -CHK_QMIN -1.0 -CHK_RMIN -1.0 -CHK_RMAX 1000.0 -CHK_EJECT 1000.0 -CHK_QMIN_COORD HELIO -CHK_QMIN_RANGE -1.0 -1.0 -MU2KG 1.988409870698051e+30 -TU2S 31557600.0 -DU2M 149597870700.0 -IN_FORM EL -EXTRA_FORCE NO -PARTICLE_OUT hungarias_5pl_500tp_17_particle.dat -BIG_DISCARD NO -CHK_CLOSE YES -RHILL_PRESENT YES -FRAGMENTATION NO -ROTATION YES -TIDES NO -ENERGY YES -GR YES -INTERACTION_LOOPS ADAPTIVE -ENCOUNTER_CHECK ADAPTIVE -ENERGY_OUT hungarias_5pl_500tp_17_energy.dat -GMTINY 3.646098141953443043e-08 diff --git a/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_pl.in b/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_pl.in deleted file mode 100644 index cd9d16020..000000000 --- a/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_pl.in +++ /dev/null @@ -1,49 +0,0 @@ -8 -Mercury 6.553709809565314146e-06 0.0014751274117575772341 -1.6306381826061645943e-05 -0.38709894990924181846 0.20562369687869339052 7.0036069691825035832 -48.302897646473702764 29.190213908309409874 163.69992642152809026 -0.0 0.0 0.34599999999999997424 -3.5735549824428292985 -18.380047749494480457 34.361526740492798437 -Venus 9.6633133995815381836e-05 0.006759122875155079725 -4.0453784346544178454e-05 -0.7233300630551103838 0.006773384545514573099 3.394505355540899938 -76.62090440289564697 55.183156101464518883 271.2285045598760007 -0.0 0.0 0.4000000000000000222 -0.17650282045605921225 -3.6612475825356215592 8.702866268072763821 -Earth 0.000120026935827952456416 0.010044657392872289059 -4.25875607065040958e-05 -0.99999328599172943033 0.01668004783869252855 0.0027793940989077428085 -175.84932558359508903 287.2227751976308241 324.72725799674782365 -0.0 0.0 0.33069999999999999396 -4.827962479462605839 0.034731626640621778608 2301.2114260455621944 -Mars 1.2739802010675941808e-05 0.007246146587933918669 -2.265740805092889601e-05 -1.5236121180553410248 0.093387475645674775104 1.8479297186242829021 -49.490271729763087194 286.7387645553690163 252.78317601821959215 -0.0 0.0 0.3644000000000000017 -997.9376283354346323 -909.38573894978675416 1783.4600697011568969 -Jupiter 0.03769225108898567778 0.35525381666404283465 -0.00046732617030490929307 -5.203268729924161562 0.04848413524543258163 1.3035624911873560094 -100.51639734596980702 273.421918018626684 325.351028522703416 -0.0 0.0 0.27560000000000001164 --80.967241888586720104 -2387.9998942634933492 5008.7344122962876782 -Saturn 0.01128589982009127331 0.43764770913411007376 -0.00038925687730393611812 -9.581513697274186114 0.05248801962394190196 2.4862838811768979141 -113.59546767797320399 335.45662431368151601 228.84653123700309152 -0.0 0.0 0.22000000000000000111 -441.9323685947327233 378.52918410105413535 5135.911248678291292 -Uranus 0.001723658947826773068 0.4699394560146697986 -0.00016953449859497231466 -19.24773626798451076 0.04408736292912442123 0.7704474968533898682 -74.09072726634606454 95.12631113857929677 237.66915583105441101 -0.0 0.0 0.23000000000000000999 --677.3000258209181323 -3008.109907190578637 -836.301326618569835 -Neptune 0.0020336100526728302882 0.7816500366521773358 -0.000164587904124493665 -30.297815841143489024 0.013873050398302080172 1.7688477929856469828 -131.74107055888509876 246.83916166351488641 334.07963351871291025 -0.0 0.0 0.23000000000000000999 -1231.0256802954641403 -2178.2009371051150557 2329.6179923847095223 diff --git a/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_sun_MsunAUYR.in b/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_sun_MsunAUYR.in deleted file mode 100644 index b2cb85c35..000000000 --- a/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_sun_MsunAUYR.in +++ /dev/null @@ -1,7 +0,0 @@ -Sun -39.476926408897626 -0.004650467260962157 -4.7535806948127355e-12 --2.2473967953572827e-18 -0.0 0.0 0.07 -11.209306302144773 -38.759372036774764 82.25088158389266 diff --git a/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_tp.in b/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_tp.in deleted file mode 100644 index 573541ac9..000000000 --- a/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_tp.in +++ /dev/null @@ -1 +0,0 @@ -0 diff --git a/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_param.in b/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_param.in deleted file mode 100644 index ba1fb3c2b..000000000 --- a/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_param.in +++ /dev/null @@ -1,38 +0,0 @@ -! VERSION Swiftest parameter input -T0 0.0 -TSTOP 200000000.0 -DT 0.005 -ISTEP_OUT 200000 -ISTEP_DUMP 200000 -OUT_FORM XVEL -OUT_TYPE NETCDF_DOUBLE -OUT_STAT REPLACE -IN_TYPE ASCII -PL_IN hungarias_5pl_500tp_17_pl.in -TP_IN hungarias_5pl_500tp_17_tp.in -CB_IN hungarias_5pl_500tp_17_sun_MsunAUYR.in -BIN_OUT hungarias_5pl_500tp_17_out.nc -CHK_QMIN -1.0 -CHK_RMIN -1.0 -CHK_RMAX 1000.0 -CHK_EJECT 1000.0 -CHK_QMIN_COORD HELIO -CHK_QMIN_RANGE -1.0 -1.0 -MU2KG 1.988409870698051e+30 -TU2S 31557600.0 -DU2M 149597870700.0 -IN_FORM EL -EXTRA_FORCE NO -PARTICLE_OUT hungarias_5pl_500tp_17_particle.dat -BIG_DISCARD NO -CHK_CLOSE YES -RHILL_PRESENT YES -FRAGMENTATION NO -ROTATION YES -TIDES NO -ENERGY YES -GR YES -INTERACTION_LOOPS ADAPTIVE -ENCOUNTER_CHECK ADAPTIVE -ENERGY_OUT hungarias_5pl_500tp_17_energy.dat -GMTINY 3.646098141953443043e-08 diff --git a/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_pl.in b/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_pl.in deleted file mode 100644 index cd9d16020..000000000 --- a/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_pl.in +++ /dev/null @@ -1,49 +0,0 @@ -8 -Mercury 6.553709809565314146e-06 0.0014751274117575772341 -1.6306381826061645943e-05 -0.38709894990924181846 0.20562369687869339052 7.0036069691825035832 -48.302897646473702764 29.190213908309409874 163.69992642152809026 -0.0 0.0 0.34599999999999997424 -3.5735549824428292985 -18.380047749494480457 34.361526740492798437 -Venus 9.6633133995815381836e-05 0.006759122875155079725 -4.0453784346544178454e-05 -0.7233300630551103838 0.006773384545514573099 3.394505355540899938 -76.62090440289564697 55.183156101464518883 271.2285045598760007 -0.0 0.0 0.4000000000000000222 -0.17650282045605921225 -3.6612475825356215592 8.702866268072763821 -Earth 0.000120026935827952456416 0.010044657392872289059 -4.25875607065040958e-05 -0.99999328599172943033 0.01668004783869252855 0.0027793940989077428085 -175.84932558359508903 287.2227751976308241 324.72725799674782365 -0.0 0.0 0.33069999999999999396 -4.827962479462605839 0.034731626640621778608 2301.2114260455621944 -Mars 1.2739802010675941808e-05 0.007246146587933918669 -2.265740805092889601e-05 -1.5236121180553410248 0.093387475645674775104 1.8479297186242829021 -49.490271729763087194 286.7387645553690163 252.78317601821959215 -0.0 0.0 0.3644000000000000017 -997.9376283354346323 -909.38573894978675416 1783.4600697011568969 -Jupiter 0.03769225108898567778 0.35525381666404283465 -0.00046732617030490929307 -5.203268729924161562 0.04848413524543258163 1.3035624911873560094 -100.51639734596980702 273.421918018626684 325.351028522703416 -0.0 0.0 0.27560000000000001164 --80.967241888586720104 -2387.9998942634933492 5008.7344122962876782 -Saturn 0.01128589982009127331 0.43764770913411007376 -0.00038925687730393611812 -9.581513697274186114 0.05248801962394190196 2.4862838811768979141 -113.59546767797320399 335.45662431368151601 228.84653123700309152 -0.0 0.0 0.22000000000000000111 -441.9323685947327233 378.52918410105413535 5135.911248678291292 -Uranus 0.001723658947826773068 0.4699394560146697986 -0.00016953449859497231466 -19.24773626798451076 0.04408736292912442123 0.7704474968533898682 -74.09072726634606454 95.12631113857929677 237.66915583105441101 -0.0 0.0 0.23000000000000000999 --677.3000258209181323 -3008.109907190578637 -836.301326618569835 -Neptune 0.0020336100526728302882 0.7816500366521773358 -0.000164587904124493665 -30.297815841143489024 0.013873050398302080172 1.7688477929856469828 -131.74107055888509876 246.83916166351488641 334.07963351871291025 -0.0 0.0 0.23000000000000000999 -1231.0256802954641403 -2178.2009371051150557 2329.6179923847095223 diff --git a/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_sun_MsunAUYR.in b/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_sun_MsunAUYR.in deleted file mode 100644 index b2cb85c35..000000000 --- a/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_sun_MsunAUYR.in +++ /dev/null @@ -1,7 +0,0 @@ -Sun -39.476926408897626 -0.004650467260962157 -4.7535806948127355e-12 --2.2473967953572827e-18 -0.0 0.0 0.07 -11.209306302144773 -38.759372036774764 82.25088158389266 diff --git a/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_tp.in b/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_tp.in deleted file mode 100644 index f4ba244e1..000000000 --- a/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_tp.in +++ /dev/null @@ -1,1501 +0,0 @@ -500 -TestParticle -1.8454769027014339411 0.13951119042459186881 25.837798047275626345 -328.17117785206306735 237.2860880034895672 64.23008023926446697 -TestParticle -1.8948047399930760815 0.39253684339890981825 30.57401904357708844 -171.8160167926455415 74.67067835186652758 346.82539114732162489 -TestParticle -1.4322956873029448754 0.26682998123758877584 36.888797433998760766 -135.67836179139501951 49.89780708941236753 50.12940813296061293 -TestParticle -1.5422738860284694873 0.37685139101297421282 19.245291067203744717 -242.6056203622448777 190.34039186776647057 265.5775848896740854 -TestParticle -1.4000225346968613316 0.29255853399659431657 19.890767084525684538 -119.10518346196536754 348.49038108835299 47.293501598324468205 -TestParticle -1.456396703278512561 0.21606816556140612251 29.008692147879436618 -108.30731953608933793 221.35606614343436149 135.6522448644592771 -TestParticle -1.4991966146428574724 0.2669401594934397437 30.077755049056197123 -191.15663442447419129 222.38194219090249248 69.087779756302211354 -TestParticle -1.2976220185588704936 0.2964166811906516763 17.074990789432430205 -304.33208099940674174 258.6470139846816778 322.57928297363247339 -TestParticle -1.2284058459883253622 0.02114032275754222992 21.48034199376179032 -253.91897753388707315 121.66008318006832667 48.90451689677965419 -TestParticle -1.3491703154567693534 0.12631152383406446527 12.08570156851411781 -94.79536576066179521 143.49729046755351192 208.82266091055907964 -TestParticle -1.354548306636307764 0.30813073753578051894 26.385704559503864175 -9.340695923175923454 140.9062990975310754 128.60525944669927867 -TestParticle -1.4726763914941964906 0.051608113984077212677 23.16805302210511286 -60.87571895315940651 37.85205814142705094 334.24673224972650587 -TestParticle -1.5463324166991267994 0.049680078831149866725 2.1376306166210978787 -220.16008032774595904 11.76294270807032305 189.70726088424217437 -TestParticle -1.8424848789863070841 0.22250945291262835823 31.15994606422547264 -200.26190393952850854 90.472365503047569746 91.504582635979360816 -TestParticle -1.3344201535197020014 0.22773738327276721316 26.57752464191161934 -153.96142537752339763 186.86606427694519539 35.556703962561442722 -TestParticle -1.9184874234026485507 0.023481756935774280443 35.397883111232822273 -271.86866710708176242 55.05965672749781703 149.58202579969920976 -TestParticle -1.5321856218987717213 0.3979302949006976453 2.3033304058957959626 -1.0080751214383187886 229.5039187263292888 149.08850733126683963 -TestParticle -1.8579680598185155382 0.22191671822921349433 4.132202808256058013 -84.407322217061448555 105.02111083305797479 146.60404199861849861 -TestParticle -1.8191335218869923995 0.081164276322499742666 2.5841250683973493452 -159.5912052269758874 90.717444711181698835 52.736155424681527393 -TestParticle -1.3667350901122115037 0.040168371245059432406 21.275121073210776501 -354.85336821525999085 78.43154031841972085 317.9997578721723812 -TestParticle -1.211310325452651826 0.22495050228658303171 6.171244471860548586 -261.19666701924728613 72.22571277624209074 188.79752520382470493 -TestParticle -1.5325985395295633751 0.31279786859050073833 20.80765006283890628 -318.17303457104600284 237.18051290105893258 171.10337432510698363 -TestParticle -1.8680074840187885776 0.2359667145186353232 3.4681761306941005785 -200.43760942249792834 358.90361110235892284 209.24526446322295214 -TestParticle -1.8902919155434694254 0.083578216274719355217 21.112558775866592242 -196.8514015184809125 347.4309841941474133 73.29619835953663198 -TestParticle -1.3627905330289311614 0.099888583939379896326 10.927033380075510394 -304.94152566655765213 199.55238917120914266 66.700355986912740036 -TestParticle -1.6040569601728904559 0.0037929451167165065088 35.906866500389931218 -99.48570161019421221 264.107310263435636 196.91578900528253371 -TestParticle -1.5861188083181421149 0.12827049258664038889 4.433072269138715882 -250.35776905499878353 45.94314631274010452 78.766936071707490896 -TestParticle -1.8085832921727800215 0.38738844761580382148 38.482814871600758977 -59.61087191956130482 302.66582104517908647 337.43444136948141931 -TestParticle -1.4784945066780474932 0.02330664972959981679 24.805661482861435019 -161.3343149737517308 260.74004269183234328 332.58410511792851594 -TestParticle -1.2147867771614853094 0.16512447645289687892 26.704102750300808822 -342.71215159236965064 303.68316149292064665 267.30686157877283904 -TestParticle -1.2201597354758311198 0.29779565538112623413 9.5137682254248456815 -191.53033272117548336 279.0125127827463416 212.78518850631689929 -TestParticle -1.6306412809893466864 0.17831015307074157827 3.1250419675817919796 -35.17124037365346112 108.44038602029890228 289.87991262900078482 -TestParticle -1.2151606182820764435 0.030818630012030868992 15.255139624036321067 -18.872922094318155928 231.7787216922804987 114.00766773514217789 -TestParticle -1.263893046608108861 0.2365742775318666613 11.945519016269416923 -42.860493283933593034 103.96603523733477914 283.38829024952065083 -TestParticle -1.6208609899851271763 0.084237547629803233296 12.70952077968544458 -283.22127471251508268 16.774057774443846824 300.16022765529646676 -TestParticle -1.369439844040318377 0.02479558882423171795 12.8318676295292597445 -301.63112212878189666 317.34595898371384237 30.617048625074787083 -TestParticle -1.5997694540834734855 0.09458558350377295476 19.448014834633401193 -12.1917196597836952066 3.3679767469261356894 154.78568082871979072 -TestParticle -1.7665402755717471983 0.30325026057285930925 27.633560559304825688 -101.32565005973741279 173.42784439679959974 37.232060344515574002 -TestParticle -1.9955375108845494481 0.36780600821797326816 31.984293078717442427 -282.80116122029363623 340.83055441100248117 39.611552110590793063 -TestParticle -1.8068990906750328485 0.21026617244057629885 1.0616116239923245601 -148.12562556977400163 298.30253571723386585 39.94475612648128049 -TestParticle -1.6630081107132843599 0.2735942970781838346 20.393789507385111648 -186.34515293922132173 65.17268953054855274 249.5770342523899501 -TestParticle -1.7985429554004617181 0.32088199656574384333 3.421215620948947489 -16.760921442599428843 74.095210179753522084 131.64141600391005227 -TestParticle -1.4370805125444752193 0.33325879590334600566 29.297209939601689399 -179.87886700027897291 9.64820682838999133 185.83130754139918395 -TestParticle -1.4655739620290153535 0.017666725980597774298 15.194095015809558902 -272.98954032167330297 58.084307572382229523 205.40990717491945361 -TestParticle -1.8476543863511110111 0.38915614646375812358 11.917542586934226634 -134.42337723208845546 335.9708646376130332 1.2971084841705504687 -TestParticle -1.4590877868615714785 0.00229625206779173743 3.1321552894228821273 -234.02046406252858901 255.12979045887780671 16.475368403924544936 -TestParticle -1.3888300055647480047 0.04773585409741545882 20.980957411518524225 -232.75615771007392141 269.83840631297238133 128.91250646333895702 -TestParticle -1.9931456375147125204 0.36812801925517474322 8.575906190939374341 -75.54998759463583724 336.19060016425089543 128.81172294803698719 -TestParticle -1.8774492133690419138 0.3438244675687084917 23.038981078440741612 -9.8914055387747712444 56.58764160659445963 274.986529163730836 -TestParticle -1.3204375538736723428 0.08737144541036796774 29.974540925371840672 -221.62895491427303796 180.74872085610940076 337.40135640751742585 -TestParticle -1.7927656300808507694 0.117314349174642992835 19.184850306121404628 -206.67799209022632567 27.751086824061687253 298.02149638567931333 -TestParticle -1.7770751091671890265 0.19250351376309945972 9.172954305563960631 -43.26806500508915576 40.25028641050728595 238.70170337404292127 -TestParticle -1.974616589119178478 0.34407442172588997842 9.802858566374489158 -297.25364573770326615 87.77531802870282718 75.66951173963438748 -TestParticle -1.3863166307158814039 0.076685155941225657816 27.402627668756696977 -65.08259549484182571 164.8638775674021133 100.45589134667613962 -TestParticle -1.865440866859517488 0.1196471086364425257 11.945324988836505398 -268.187594819792821 223.64720186520361267 29.40940210460087556 -TestParticle -1.924611171111724417 0.20112445232693854091 27.71898676703103348 -318.34445645026778493 191.25112555799532288 349.89422766228875616 -TestParticle -1.5993892099645203864 0.10968442780595713537 9.326690310948993812 -31.533935713187357663 310.02898225335894722 210.51997485541662058 -TestParticle -1.2359382488484538243 0.32658357473851062913 38.707976308555153366 -144.00217869231852319 119.06805794770258444 79.384200277529473055 -TestParticle -1.6109049166063780234 0.038297945827820673026 19.543826335927839466 -187.13697315293387646 257.17832502585736165 137.87766714187893058 -TestParticle -1.4314628393318562516 0.06605107757031168647 34.48524969280026653 -261.32336202719972107 132.91845049023550018 38.845354985336733478 -TestParticle -1.6270574875899108669 0.34703206127568098083 15.7198484814636287865 -347.55110983950402215 301.80674145531685326 112.25474179150697296 -TestParticle -1.2336395323546296421 0.09729394203067305569 5.1016432554912771735 -233.12366663108903708 146.38256752560837981 198.90738568911748985 -TestParticle -1.3456767380773657639 0.0037474665741684012703 39.938234490697439583 -256.57759604724572 75.054619437472723575 358.3650510442133168 -TestParticle -1.5755427111046413913 0.26176654357687628716 8.3705428253832359076 -37.517264866504824283 65.328654571322900324 91.55626866074713632 -TestParticle -1.6755570822166401257 0.13402717291758836637 24.063895956419415256 -13.799270685071709508 72.62055343894668624 87.31894896673983908 -TestParticle -1.5559490988866435668 0.15176826381840774483 38.48111346610262018 -256.2333379875098558 75.97800331031197629 59.41813313856062706 -TestParticle -1.44994652075586683 0.33986546456988747655 24.751134550954795088 -232.18945993885864709 196.68218102285592863 134.45246030705607154 -TestParticle -1.8429185809905443971 0.017095748280579449452 37.139787427802218645 -161.43471520401584485 307.27501647662722917 355.50902004252696997 -TestParticle -1.8754638534803846905 0.012020551314167439438 25.689663713162978809 -190.79044364156195002 199.61943428385487209 354.13757823278496062 -TestParticle -1.6785085343609076336 0.092751885821403062815 9.210612929641403213 -285.5852225501039925 151.86743084166838003 284.55869958326974256 -TestParticle -1.6543220378661067649 0.21134650270613800083 33.840207882222927083 -304.1335703446064258 326.82908020011677763 324.19035648687139428 -TestParticle -1.532142838634183768 0.38007507167758092237 0.41347334753230935434 -67.05133558163640828 34.399290053628249098 34.840294234675972973 -TestParticle -1.5607062121608026306 0.33781855969656376937 8.967843423326943508 -299.3643723824862377 200.63715648972143413 68.959909224159687824 -TestParticle -1.4493452438508076519 0.0685471748773834183 8.6320194163908645635 -72.080624314054560386 115.122237950328312195 0.4079154529894424286 -TestParticle -1.6460340581063395149 0.39668168452346741493 20.981074587513283802 -204.3451792276263177 201.37614636656564926 213.30860176845612841 -TestParticle -1.5920263567710581931 0.25848484530126630832 37.015946260712674132 -127.874562568991194667 65.19741011690945243 94.70447850395582634 -TestParticle -1.7336512363309442009 0.07029270812373322741 2.7619103909209741232 -186.8230602145383159 227.39378660430725176 98.630627655617857386 -TestParticle -1.2180382444813300236 0.3142235003505371993 28.081856084101627147 -111.345098722858793394 55.920002664921518942 282.87486367297071865 -TestParticle -1.6485319714902004762 0.3152277024193525512 9.613333711481617527 -294.21829832085342105 286.30105207001298595 128.67843292368630159 -TestParticle -1.4661249318513216444 0.05768902442216044396 0.40134055259916312508 -131.60830524837382427 243.75402215940340511 207.34266824752899083 -TestParticle -1.9808876352137643195 0.14308188258148502037 1.4378912336896432222 -80.646845170624999355 231.53252144735679963 232.24754717746816368 -TestParticle -1.2317104124445219515 0.2601604050852836525 0.45344055155487783537 -196.60019387641727917 281.28440095008312483 247.80040663000707468 -TestParticle -1.9766606334273690848 0.34561610666945052905 23.435434834980789276 -34.473035596172188377 271.1594424183512615 48.466138898201464258 -TestParticle -1.902283887520531902 0.11209856668107276434 36.03239655947709963 -294.40684092368923075 270.02199923071918874 114.382104661423511516 -TestParticle -1.6492323095244016962 0.15893979864294510707 37.659784271934086064 -104.66474319501168111 339.31942052690538958 216.02473301930888283 -TestParticle -1.3484148267391067311 0.21111072648635398341 10.89667366492733791 -291.56591682201212734 76.70162083026228572 312.33817224861377326 -TestParticle -1.4294351818194139803 0.088023727454350997323 39.975651469559892348 -198.68831704157523177 24.599669214308292453 112.67218982565516683 -TestParticle -1.7462490440076519072 0.37071438804152889723 21.870120107958371136 -306.73669065023256053 227.86908802150850306 221.53115484665687518 -TestParticle -1.2326287663421375829 0.38251042858385364553 15.802748366587309192 -199.40278420565533679 149.69869717845381274 315.67560896416114247 -TestParticle -1.8450862453370659999 0.35823810152470403345 0.24296995062495163609 -231.11355647090658749 268.36408970924156847 247.20131497380242536 -TestParticle -1.3463306194321635889 0.054152156717265725883 19.291673537548810202 -161.87111271376406307 110.46662751206984865 211.17562619004070257 -TestParticle -1.7304729990392044847 0.0060363382745066036794 4.5425988088905189244 -83.83165898233737323 161.12905358043980186 286.6647995328502816 -TestParticle -1.272415258736352639 0.34812105948963872892 35.045494396081245725 -14.574000729875393745 353.3713665259786012 131.5433867402096837 -TestParticle -1.6439273487752854574 0.36545065070539850538 6.353634441759323792 -208.14453818563018217 10.813063425795590433 206.06730287545840952 -TestParticle -1.6763079933342956984 0.094138501830316120844 9.085159707293687603 -80.58871476637817466 314.0368013316636393 100.690960685859835166 -TestParticle -1.4877140448295171904 0.16166761889883485281 34.241465691047999087 -79.8410863542756033 83.93580251433438377 326.42504725591442138 -TestParticle -1.2162284372972316238 0.0041396912261435492297 18.10971019209766908 -119.24015567046335207 329.67281909144981 104.828869567280364095 -TestParticle -1.8047735542382463692 0.33749016396948239294 0.52972364011479644574 -178.94392698813351217 299.23756071934496958 162.62104380151879468 -TestParticle -1.5839648306862472715 0.10066137160625268643 33.26828317225646714 -263.27920251880794922 68.67162164080139064 57.290691877799474696 -TestParticle -1.782207613297600135 0.28298109588186182162 35.127393670730072017 -210.15608294480230711 329.15212439443854464 156.34171670624388639 -TestParticle -1.3155167265331972892 0.3723026355627080397 31.9899066241260428 -91.31036979040656831 223.20537501312867334 55.827047719351739374 -TestParticle -1.5449962589928503132 0.042895131418722920458 19.621615335811604552 -53.274917868286941314 105.38186162729587636 323.020751462690896 -TestParticle -1.5754411317280814231 0.34816180369684263107 4.7678217298113434452 -120.95128002085144203 157.00930158977180895 240.29746717057042815 -TestParticle -1.5907469291141598244 0.1964357827791012312 32.411571541856559975 -170.61499094134663324 242.1650203501031342 17.501615221478704854 -TestParticle -1.830089894183755117 0.1183426089423230132 39.644525581214999477 -294.65378437812546508 109.07115594302160844 324.16241183209581322 -TestParticle -1.4367780052388956502 0.36401192064177911867 30.631206179017613778 -68.80265368578432117 273.93063220366155974 24.29554655983004352 -TestParticle -1.2142291174104986595 0.26599477562223389215 38.323418486729934784 -308.15266716976327643 181.95454939706644382 25.317934141736472498 -TestParticle -1.3097560558867786806 0.27086655670790987793 26.727111485760552512 -202.01817831967753136 111.97198753257944759 220.9572217341067244 -TestParticle -1.7068002319397266309 0.13225077417056724238 27.615823462695185952 -285.91192474987235528 163.31636137404424858 93.38394269951035653 -TestParticle -1.2055264990732839081 0.30786309414395046646 1.0578708063967390274 -10.359167032075170312 91.437369236993205845 199.49137469503560283 -TestParticle -1.507944679481377559 0.24354603379899894544 13.546984987329334871 -57.02677054315793015 348.2783664994595938 271.03255123935065285 -TestParticle -1.2000480949162781741 0.37393642722973008397 23.203234027939288353 -10.544426197782676979 54.256441116884829512 254.63780531903708493 -TestParticle -1.7449420987438828412 0.24948442565304040919 27.500692921539069857 -95.99564887831238025 273.51317842100650068 326.03984845413532412 -TestParticle -1.3765488182504534986 0.030416876982825514358 31.70464034258963082 -275.78595003182448409 133.87458225546748736 226.00553898246667472 -TestParticle -1.2429016633522536051 0.20958324622273286075 37.67591956683881449 -291.1872246516109044 179.51252843010638571 313.71221570905379394 -TestParticle -1.350836711566139936 0.37146863516149991602 10.648022816293165604 -303.44796444885918163 189.14789607745939293 51.43707686446851568 -TestParticle -1.3606071504125110128 0.33726059408562408803 29.623948782469774699 -174.22516541583135563 294.25596249059782394 95.41136217835122579 -TestParticle -1.2613426667283003102 0.28493782233230641188 2.8418286626483357793 -28.660785941482401995 87.50329638280636857 62.24419865756345871 -TestParticle -1.7174163570319429528 0.3032422501079781174 15.67069716211129915 -199.70972264612359481 32.767912430781642286 213.64123907162533555 -TestParticle -1.7458843970753306074 0.11283265730661723447 31.014841487303186796 -100.348702433335944306 70.42890181497725166 181.6379350423849246 -TestParticle -1.5856984450767472872 0.12800000166780992061 31.429108868252029652 -51.353858554652823898 23.612627758947475343 267.08391560632128403 -TestParticle -1.7153544980924069208 0.009492334383937130193 23.973160269033186864 -225.8121095708202688 166.53019043018878165 111.264606624241494615 -TestParticle -1.5026214783945404108 0.0060590469509819834884 26.922409196875427995 -295.19858318066900438 267.2316600455114326 164.01625566186100968 -TestParticle -1.9160661225785111661 0.2687972938601586037 36.621056515844763624 -334.838998311582543 64.064850181025448705 189.01682882741042135 -TestParticle -1.2176400162982947695 0.34785736514134202313 33.268864900617138858 -225.50438622677125977 227.27950095352301219 349.3797741235012495 -TestParticle -1.2273892818311689101 0.2816869543044054902 29.30501713210593806 -5.1819190308878404494 2.980732803128396391 210.95489861072306326 -TestParticle -1.3751089556704734207 0.2405885452138842584 36.06217993351511808 -199.72275209903938276 20.656954375719962513 63.697518910616103938 -TestParticle -1.5607369467841181176 0.07255978851264624496 7.9579329131271947517 -171.37467949380453547 212.58991825508687157 339.50383959100975062 -TestParticle -1.9532502979079398031 0.32689490765476852951 28.253212569212344363 -181.63986801834479934 358.1359989621613522 109.388744074059957256 -TestParticle -1.6386262719092012929 0.3843259001434648492 30.427684580834899464 -231.68744967547161195 57.857403700081057707 50.909305856223930675 -TestParticle -1.9782962700915884824 0.107957633562424437645 12.967168829872832703 -304.82496750248236594 137.36222813798312359 43.932431234771847528 -TestParticle -1.456906303967715921 0.14977091087281488302 11.183659205458482688 -73.40451433078203536 248.31190118288742497 75.220198402857562314 -TestParticle -1.2534896538060293913 0.32164641810767541363 3.6905727779895203255 -113.638768774667383354 40.160334282501267467 312.87037322501493009 -TestParticle -1.3014118589240171175 0.2335136721159586648 25.377666434917763638 -52.35427893272325406 9.000303326532378634 144.16353907228875642 -TestParticle -1.349118336295686893 0.043025081648941171375 4.3612305774961734883 -243.8860202407295219 2.8265136490351139287 103.60819968189791496 -TestParticle -1.3275933491849711832 0.30130671835155509175 9.869222679372882112 -140.91605869565009357 6.9406462242691979725 239.80228459696834875 -TestParticle -1.6818942627306852078 0.31620420657586079116 20.559233470145720446 -58.349404997197098055 117.22724335851061994 205.33268031856118796 -TestParticle -1.9852083696659352796 0.013418902816453127241 34.384158548277603984 -115.09964166928982365 93.38072290721305535 50.024657651717582496 -TestParticle -1.5693995761001753309 0.16001215059117473993 34.5933607052273544 -148.74442398288778122 35.382707682911650693 307.9784638941427488 -TestParticle -1.5266059802597138351 0.017927011927562432753 36.548915878020643788 -210.40292925773331945 201.71103729618005218 224.16233740901310512 -TestParticle -1.728092867591788595 0.17808919848065529745 20.998516569906101381 -308.92264952207932538 127.645229747456198766 161.89916144859373048 -TestParticle -1.6194915162303571421 0.12309065176675240694 11.294533006684988052 -54.678975810373955824 126.54242973288489793 198.90789595722705485 -TestParticle -1.3289490961949892434 0.29324085207912647943 30.6374181063208475 -269.87631534747202977 37.841881250480767562 348.01538484590025746 -TestParticle -1.992893537374311741 0.18673594337410803767 16.540817363482574365 -17.388276030638827763 78.86833627776049127 145.80382488854473877 -TestParticle -1.222299452110788831 0.30906300615816389987 12.345442063899700003 -306.8123712805751211 180.92912639536746155 259.40768755027107773 -TestParticle -1.4975645450575401085 0.33347394063389190766 1.5908406722909917974 -21.190900575813813589 29.47013297848204516 102.16591862721205075 -TestParticle -1.7529928369432026258 0.37348208125904397425 34.962456206016206295 -93.100816365900570304 51.110432866675402863 102.57164314281175166 -TestParticle -1.2425425262626379475 0.33615312037358630048 13.5646379554957707825 -178.52596605015196474 153.15866826328647221 144.53495382113527512 -TestParticle -1.6649955177303406018 0.2774227948724269921 0.19107601744351665474 -63.095836643914225306 354.85824120341573007 264.91047609564412824 -TestParticle -1.6484772171416994802 0.30267580759790019274 20.681865450161470932 -178.44791810461956061 236.1847171609527436 98.36374690667254583 -TestParticle -1.9932276245336744136 0.28313215139520719887 18.707112367987669188 -219.87647284127007197 126.12068590426943615 215.87266615210091913 -TestParticle -1.7032561164628601258 0.16397636271323282053 25.251751880173408438 -216.40546882883455737 157.48365299675131723 4.688955472432070337 -TestParticle -1.6688736346909214259 0.20206175633607201259 6.8253656041650678787 -216.49653061411731869 167.29352654167502124 264.9681676707442648 -TestParticle -1.8685421164356719181 0.017115665378235479788 37.702745220955684147 -341.22511657108503869 114.98911860271485352 180.97443389686239357 -TestParticle -1.2789089584183417347 0.38311485210375972876 34.310997435004189526 -320.3337196375490521 323.3381621809996318 259.21085923985185673 -TestParticle -1.6140662295704462093 0.22523087980360034788 31.289184028405010451 -342.24508460858135095 15.680010847649224814 231.38490121660879595 -TestParticle -1.9392715602121850527 0.15801671085680726869 28.474643946647489656 -130.88611486656463967 107.8187080577375383 123.51635573428578141 -TestParticle -1.2967745250719693306 0.06567169524305174755 33.95229338812422526 -290.63873117229752552 79.02208966627722475 232.82648238779003691 -TestParticle -1.5129927102068225775 0.035355940722157398748 39.88868697475624714 -192.95122284146495417 161.94702337269632153 136.8613631323482025 -TestParticle -1.6829217923833816872 0.25345881856811941502 11.3639096364677563145 -97.75123136727515316 45.772970150424697522 122.47944569483230737 -TestParticle -1.8496796135868087685 0.13179006688881342302 13.3337440463942780156 -265.13170996725159512 228.43295285296423458 86.46213418755671398 -TestParticle -1.3358066112403499393 0.14376027444378572384 39.375717961581145232 -157.40058260425848857 311.2848447975355839 331.54934076273463006 -TestParticle -1.4724981157763801232 0.09732120033570890172 28.321058818578286775 -59.894734856092107123 278.76518901350408441 80.89976806352470362 -TestParticle -1.2021644761475605012 0.31023967350442599455 28.526439154406524779 -141.17072146741031702 348.00301966689602295 345.1342457342993839 -TestParticle -1.5593994326172748721 0.1667781483451987734 33.654370780663562357 -266.88153921797828616 15.430552831803581171 331.4077165346525362 -TestParticle -1.2450357937715832435 0.028817230992748132934 35.27994061369459189 -170.88739535567884786 353.3811233168729018 235.24134924372253863 -TestParticle -1.9317961733915889333 0.3664316651845210826 24.216703033341396178 -53.371442738369651693 125.538665606108594375 100.18756180685251422 -TestParticle -1.6396980067944455506 0.35320738196817447196 38.908475459351436143 -246.96073709218802605 107.071264330560637745 337.8304256083255268 -TestParticle -1.7122870680368271756 0.33138468975426782492 22.34571124430782163 -41.625350595521808827 260.11274001626304653 319.5586433718779631 -TestParticle -1.7758391618474895779 0.055654577054355419685 14.384020683089943304 -218.7045008460380302 129.23569045343450057 314.73455478475153768 -TestParticle -1.8362854949156799389 0.17009562329070515574 9.220110348963054037 -5.6249185474454588274 94.48961934631255133 267.2078794777070243 -TestParticle -1.7334953226477165522 0.049544865778679184065 1.209613515173937337 -190.91534544660109418 64.56511824447872527 53.933623678817561142 -TestParticle -1.2066506827151026737 0.27307016461379868266 16.286012208431877468 -210.72290400454269843 4.9513407455376867716 217.19883427837939394 -TestParticle -1.9341836813541077866 0.31275777164344914505 21.744449246528134267 -16.671280260299788267 359.76195227232665275 224.80650775703034583 -TestParticle -1.2301271999661356205 0.031548406830605689455 39.849035058731047343 -90.34650036320888944 228.990784368342986 250.85529561169511226 -TestParticle -1.3410010761068889007 0.095083624572690483845 16.924908171363043152 -283.45379909314135602 86.752474366828209895 159.59709647132103782 -TestParticle -1.7698211243948773763 0.31273331984328978095 32.406541703763409146 -142.47083941877434654 108.934565017581746815 272.0311071315450704 -TestParticle -1.2184663095396561783 0.03812658809257066239 19.774618927626171683 -209.47233898474567582 217.91859195187419118 328.76297389338390076 -TestParticle -1.7206223471221142596 0.34602085721486458558 1.7719525390753965155 -165.06371680688690162 58.713339280074663407 131.55475352151159996 -TestParticle -1.3109621100006574324 0.1200549161067526599 35.241813901823853428 -280.10060451829298245 304.5154307276658301 258.67615548166588724 -TestParticle -1.890762195590066419 0.37035990280942132635 39.30878687557294171 -331.52556729751103148 337.10887406621617401 291.2002557551665518 -TestParticle -1.9459727148429868393 0.38159291851530796613 17.491010561827589953 -58.69944071533900143 205.64445683266583842 15.007877403052006571 -TestParticle -1.932411276121311472 0.04777930483056436195 25.073992516822389831 -121.57030712562516328 70.74439140769348455 289.9542940845957446 -TestParticle -1.5709963526669437073 0.10007382494413469276 31.19225199749002897 -25.663181434794644531 158.74882487098793149 349.24010777437848674 -TestParticle -1.335652850395929736 0.2682557203404010715 35.328293558121892204 -297.5826541744638689 60.254502441132032686 46.73892963602791184 -TestParticle -1.2957464098764572835 0.3440291712383192757 7.1735736922541004645 -59.24135447472242788 112.00172550339377153 63.553063734303997023 -TestParticle -1.3376569963037119315 0.3060189431378071423 33.029029350979975277 -152.73585490781837848 358.84231030107730476 37.635854669405638617 -TestParticle -1.771988403745682561 0.3418762364008507415 23.489318587551395012 -127.772934823946343386 203.78581662446330824 143.76143168311298837 -TestParticle -1.5956560402916708519 0.10759642083325884898 23.037334274387120558 -89.123439540602518605 335.80537435903943333 224.2944293252393777 -TestParticle -1.2213248137275627414 0.33273129495412528955 31.736197966218284705 -5.8113766822153190006 136.8878783815157476 64.522354495354704795 -TestParticle -1.5939091087487726739 0.18821654046060146137 30.731370977849337578 -266.58533763467028166 61.609425727717933796 18.235581197999763958 -TestParticle -1.7396585716134431721 0.33855494953671660951 29.449893101775622029 -180.02468739427200717 242.14518561194594781 286.10286226317128921 -TestParticle -1.282393302513987976 0.18117160916878405352 22.308223599873976184 -94.69043575838269078 120.90458523599184559 161.88428102391287666 -TestParticle -1.6814135190699217581 0.06566827687818244108 23.327233678731047917 -13.505074850212492876 48.75637107914376145 337.4546628636448986 -TestParticle -1.7657157709814490509 0.1428403447023711692 17.528150255810068359 -344.59038571613109525 139.36370104693307326 48.933862071120714177 -TestParticle -1.6903656227398606848 0.1881104051902828811 4.8333955434429443088 -225.1651227652955356 185.18882646555431393 132.21080070182574673 -TestParticle -1.994803202974419154 0.07010640681945860819 10.335500705227271823 -49.13850067137512667 6.4534592639328725028 80.823883651112907955 -TestParticle -1.3332640591247215678 0.06033190012542344327 21.035357456357957062 -97.733488288704805314 80.36567051536489714 46.55202086502264791 -TestParticle -1.6243595893431250765 0.19184864274731788791 3.8955991274805690239 -177.92659068814418788 143.40326100313114921 22.678654943892524898 -TestParticle -1.6823664970435372457 0.2224783311899178051 28.355960754425314718 -38.26291967170601538 109.90023925961423856 198.84047030132839495 -TestParticle -1.7191941261517613704 0.33174274738319786682 12.850948299491872007 -119.00419547116645447 97.60779700546201809 294.77008528831782996 -TestParticle -1.8572892923802768461 0.35111820477995814294 13.9604529367616514435 -90.00276864094306006 148.95323888923235245 105.97452396122218943 -TestParticle -1.3153721536816338489 0.19649899863576869574 15.0714118102473335625 -114.91054594701827796 42.412124805715073705 238.87013655434262205 -TestParticle -1.2329176043622995795 0.016982564457388795581 30.243701002322488591 -82.65191789811144929 330.6979385476704465 45.054558348890076047 -TestParticle -1.5821710473264454233 0.3143035815568485103 26.914241767154372553 -284.2538985550680195 218.88177874336824402 323.40347760377426312 -TestParticle -1.9040784761593252394 0.24428308876647972236 7.2140984856285061966 -36.905471182196343705 235.01221091601564694 318.38458893259758042 -TestParticle -1.65303582473123023 0.15480622128373774937 30.612597160930445028 -176.14307295689886246 344.8917806440758227 46.391668294041863874 -TestParticle -1.9906869462994456477 0.08417977136701382257 32.071163809129458855 -190.08888099464044785 12.337459747731131188 44.2017470332212028 -TestParticle -1.8765384210009301569 0.18365454827241262103 21.70846970886060845 -357.147106806575664 129.14807435709019501 12.280707552849744246 -TestParticle -1.4155101547192867617 0.04021447505437234643 9.344979114904226947 -15.0079117011066429654 104.10136849327774655 23.129488238006107537 -TestParticle -1.8212138878170127665 0.08047272581333581032 4.0968495722748254906 -174.58882187338159042 279.87646692565357398 23.324854698976157152 -TestParticle -1.7644240552946159895 0.028115303133601266677 37.495056810553286653 -118.13225365926875554 167.45393279647143459 34.012411764895496447 -TestParticle -1.4525677350618968475 0.30250405555180709394 17.82996354610970613 -220.00796720803919015 344.15563445760545846 123.14676507835467589 -TestParticle -1.548841766197246228 0.09540860671062662002 22.684926251185043355 -218.60911597389889494 90.33458573673138403 102.992143880334552364 -TestParticle -1.2079296534119159379 0.32769989355099571338 38.675927266126485904 -200.13361220962531206 158.78840734969233495 279.3835775172844933 -TestParticle -1.377134208847530239 0.24021816899861267447 9.0547885117482262984 -307.8373588937357681 250.70142057430294358 309.94009295835280682 -TestParticle -1.9686740753046718666 0.039229853667286734842 27.8754113045622951 -44.123357114694904624 256.01312835054108064 261.81824327677321662 -TestParticle -1.5814217806739057082 0.17335298748077404563 11.896107065940920933 -11.863952502714919746 24.317879056812333971 281.83737446678952665 -TestParticle -1.3875566874932281358 0.04186652452005912295 8.374003796839994962 -110.23215119957482955 294.56036703267886878 295.56595853737684365 -TestParticle -1.3902402383167473676 0.19593968424019078678 29.315181048510574158 -282.62385234829253022 324.77635841333739108 19.922520312932118003 -TestParticle -1.2840096543928043449 0.29990999639214999117 38.008971094948456937 -277.38971452757238012 208.06148201248271334 255.09629766073103951 -TestParticle -1.5591506829846155657 0.37436941724804151388 28.992037551395654305 -349.16296285001351407 325.2167596752620966 272.84514086043867565 -TestParticle -1.6470838643939573753 0.08288833139777805614 14.577369178129217175 -285.2260666698484215 331.09186078156602662 265.88764593799055547 -TestParticle -1.4078732644616405167 0.12168143435803764618 12.108634490395427719 -108.46688890223232704 161.29947110408681965 275.03585750375651742 -TestParticle -1.3806299194725459856 0.004926651150672434372 4.619034071475587311 -124.92525284958901466 247.86360149925218366 213.62866269117026263 -TestParticle -1.3192455632849615643 0.2895763215200138352 26.694213488950907731 -156.54596065699396945 129.81140517153278324 134.60446380394492394 -TestParticle -1.4439912056109245331 0.3898931766577775071 8.96508289894697441 -244.87528934455733065 193.64710431202621521 293.37512055758975293 -TestParticle -1.8635206283775769265 0.2795056553246003106 32.898054005194971694 -137.04912054787823195 287.93791057659291255 10.142083183616289688 -TestParticle -1.9812056783962854745 0.2247292940884803858 25.532351672534726816 -201.33822039314060248 254.90475216060337971 359.59652623258176618 -TestParticle -1.9116361511506723136 0.34944272223947114853 5.3334830645261233073 -165.89953551606566862 87.00762822041266986 286.54555713608760925 -TestParticle -1.2300510950958833956 0.09272681808089294764 6.1108306263088341126 -60.392041334648261852 166.06618730050502108 214.40030029409305712 -TestParticle -1.6587060971893274886 0.35283027123356813792 31.860313399205129059 -249.71240866151026694 222.43577149272385896 31.641338378167219503 -TestParticle -1.6042337378433173534 0.37025740688655151 17.202399535173533707 -87.81318396148407146 2.5620013176806422095 357.37399955588330158 -TestParticle -1.6471345300326571959 0.13620174045721983314 22.615216955031499424 -80.62529682810802001 69.592694813600971315 105.76774944494903252 -TestParticle -1.9072984229216274343 0.01501546063666405785 8.290907351796761304 -169.80316939963415734 18.043578597928426888 349.8451486157899808 -TestParticle -1.6906614679737514972 0.18058500638001656613 35.641943093270654686 -155.08172745880321486 318.8449035930426021 193.87642754894059749 -TestParticle -1.5896626347240321309 0.08039921506021037445 26.884736251329634626 -93.207751799271306936 291.57502433845007772 164.72382015911426834 -TestParticle -1.6992934898451703685 0.065201137301299824656 14.269610927403233447 -236.09727012824436088 254.53147047225508004 263.77965229044838225 -TestParticle -1.8538533648632840034 0.04766458860664664343 32.873078543951940844 -204.22879507518445052 106.636047257291238566 249.48280450502983285 -TestParticle -1.4212096807741136928 0.07499446462853280593 23.101996292119086007 -275.60817514452082833 213.13272785623379946 230.30352647630064666 -TestParticle -1.7510124795524912855 0.057099861992605485672 26.912262589245482758 -293.1635508220617794 35.9907631662996792 141.04718451469835827 -TestParticle -1.6563019761734052437 0.025865878674105769602 36.786210320613299984 -182.00701529286254754 302.4937526698793704 324.59294681664295013 -TestParticle -1.729605636071602337 0.11527751871838157194 8.269004569267789151 -347.6614584046645291 246.54991472345386683 257.4460526186617244 -TestParticle -1.5759605048363587443 0.11372511990649024349 2.1138568479458896832 -32.388292718466615838 301.59398434276658918 321.32099521949635346 -TestParticle -1.8344051151510727404 0.26899383835918777574 3.9802801398091425256 -84.71344253866337226 168.80695388443507454 259.706671920307258 -TestParticle -1.9193495257732000603 0.3433984358229728029 11.27141574019314163 -62.069125737912351326 344.62614387614092948 49.455425729806016477 -TestParticle -1.7910635325425254827 0.044197943689674758228 33.673496401958495028 -49.096060175323778196 333.20352819343492 344.1647888658290526 -TestParticle -1.3951416310339623816 0.25049231139019290104 13.926920554033479505 -24.468782285640848784 283.9433213127680915 38.716618949049291132 -TestParticle -1.4774439717601555166 0.34321703341922732422 34.23200733980726085 -253.1569295809615312 208.55072402648170282 142.78123543474748658 -TestParticle -1.8035383416573496085 0.31178214061844072846 38.848219271007792486 -163.78980370879801853 27.192135308956363104 240.49835213590739613 -TestParticle -1.8523952866624258107 0.2010708076570819347 22.034325231090594599 -124.711476085711595374 323.0644792551414639 138.10178915634389796 -TestParticle -1.9173340778250498317 0.2780025712872400967 25.973495130250071838 -193.9471251677579744 256.51445549034934857 68.5799795393802043 -TestParticle -1.2039954656193134763 0.32062119894339707882 11.801770668367792538 -261.58407010163364248 130.72550628237604542 295.22935271302458204 -TestParticle -1.3539793779063435952 0.05619140956045583224 0.39149769265351963554 -54.55272735280637164 335.83544373800691574 89.36258771851326799 -TestParticle -1.9516074079116982887 0.1921645005309346732 35.371640156848229708 -152.55319109406485723 247.31165449235123788 278.83909188690222436 -TestParticle -1.9301130006872968536 0.047382794904003239234 3.296738006904260665 -186.93636419954495409 38.829849755176162773 177.44532754290727894 -TestParticle -1.2580985637358546025 0.21204965723905899733 16.1659140062293325 -3.289189867948967283 190.84482276807500511 67.97050011468211039 -TestParticle -1.5295225293999865634 0.17172263806479373671 39.618093381378386653 -332.6463231490124599 278.70254383892529404 12.693771958962534185 -TestParticle -1.3231257344221201144 0.2573419902802399073 38.0841373767418645 -20.119441148442565037 244.32686028253979771 48.572638095274754733 -TestParticle -1.2390492871187110957 0.23798618359691314783 30.645766685864785472 -87.001950267678836326 278.12670273948640443 330.89492423249123476 -TestParticle -1.3993417216526349289 0.031843494342214208326 14.144935673919892594 -72.465298766095699534 334.2534597720372176 30.48791433958904662 -TestParticle -1.5347486253277040635 0.04338458251454313519 12.0921328741059639356 -120.79694902396420275 355.45117743828626544 160.7907173842522468 -TestParticle -1.2904906197620742425 0.28414011519071485923 33.037713210604835012 -289.81253890944515206 83.576357577029270374 220.09709176383933027 -TestParticle -1.6058032451228929638 0.36018141227094635504 17.994372902660266789 -3.7010845253058599624 141.54942979100397338 198.05616798418643043 -TestParticle -1.7714414500542230435 0.0035609242707668187222 22.050030319794334588 -264.59185760489833683 10.605770272399395182 215.25949766508875882 -TestParticle -1.81709217161712 0.27368429441007163794 17.149545687672187455 -35.988324614781888044 81.77856120500719328 10.201466538617181001 -TestParticle -1.9507969820486321666 0.104826252022570107214 21.570178232673107743 -110.11799658110533073 203.10615346805144554 174.54637699366600145 -TestParticle -1.5513016726876260876 0.0649073896097557973 28.406030811013923909 -294.40827400152136306 308.45384003953444108 250.69412013121518612 -TestParticle -1.6081730286462514457 0.0904772003540942199 8.756397654381963491 -95.30241023766843966 310.97856820924152998 78.51553642084900275 -TestParticle -1.9445060562513780678 0.34581412562291430346 38.93528925234138427 -322.18458452998703478 206.50871262487711988 171.6753679893202218 -TestParticle -1.2867830568980889172 0.23805020747269362014 30.605085071406584518 -107.834941188806425316 172.69897682961376972 231.64156285513004718 -TestParticle -1.5570299212666793842 0.34247490116827700168 25.701729758850273555 -57.759342054473357564 275.21368529820330195 0.5189093555138457603 -TestParticle -1.8297728730942826036 0.0059327247000139143526 26.27006410810665571 -351.91597475003959516 332.46172667657117472 193.83113607968971337 -TestParticle -1.4663451402621732189 0.019337346272064428326 0.491698998445047053 -336.79769240394642793 248.96724280968578569 175.15811073921727825 -TestParticle -1.724576194857081024 0.052697296256256631608 5.7447084496883027427 -66.182723011463494345 29.130322702617217345 339.9870439485365523 -TestParticle -1.3696669727225077029 0.33229023795273532338 39.64244722837145929 -133.49050184888841386 162.12402403598608203 293.04583577859932575 -TestParticle -1.3783417053600715008 0.2855227081254033128 11.873396199324094624 -181.03404330551020962 111.58079564001488393 50.497053185226064898 -TestParticle -1.8637392080726669086 0.0156183905360887560765 26.799919264480482894 -101.416124536033450454 141.64824974137857794 87.10767556818554169 -TestParticle -1.3990411255817394309 0.016424027824586850954 34.17231113580791657 -351.25674680067004374 51.410447621435544363 109.4743571087562799 -TestParticle -1.7113078627771947104 0.087396542572623220346 21.48366722009397023 -331.26077825265491583 87.597172428811916234 351.11237329056922363 -TestParticle -1.6537452602438895699 0.19076978286361276349 30.899468439263419128 -338.97921655361312787 354.2717007607652704 88.459659106615376345 -TestParticle -1.8713204845226436568 0.34948347966477527615 26.694021521206035885 -22.640920338079904894 267.1658484538838252 91.263466282262129425 -TestParticle -1.7800499814903345541 0.21591168642547953205 4.15893255030611364 -284.8692985786169629 273.15026927162216452 163.62920354405895296 -TestParticle -1.2770584465418410858 0.11704921307575957834 23.561299361007908004 -208.69763432291699701 114.84562071374233483 106.557589971007203644 -TestParticle -1.7789101924514278963 0.21089404756926086182 26.446391287965887784 -166.38039683220225129 280.94687192438289003 156.1732356226829097 -TestParticle -1.5095803628848272204 0.37888764670309865723 23.739638145042558648 -147.5462561757028368 320.06107890549310468 221.66365612858550094 -TestParticle -1.431320096709388201 0.090307147024224890264 8.768204975989792871 -86.741239636344801056 122.03132838806067184 343.580887072082362 -TestParticle -1.6349437899113876682 0.14387102541744481443 11.841216176535350968 -51.14042919054931957 69.171034829460595006 213.79008663660533784 -TestParticle -1.689003605562497734 0.13061345081474304286 24.749487065465949343 -180.96919715736157741 204.68845725307318162 260.67277137781871943 -TestParticle -1.3035444430147782313 0.19990048901013623972 15.958381821114077326 -24.968896817823825529 197.33820599380237581 119.001287940231961215 -TestParticle -1.6620625944290643439 0.2734543708115155236 30.556744105988030924 -323.42922129424488276 115.879900714354221236 18.69101695694187626 -TestParticle -1.9572874068027543704 0.3982637334300366816 23.395690692151514867 -282.1199835387070607 264.2819579212129497 226.80637570406867098 -TestParticle -1.7711614884940887205 0.16471476857196881705 34.541413045241888824 -209.78439563147685476 330.68687123431953978 302.79975669488345602 -TestParticle -1.2768346788945352799 0.2680189005217827325 2.3664781607185281231 -4.5230625737162633015 309.27315231219478164 35.64300138830596154 -TestParticle -1.7331467818212080712 0.08199012177664927181 2.5002689592511995187 -16.248296777956340975 8.818474849161844986 133.32825103025075464 -TestParticle -1.5824962842528258467 0.1664685697946028109 39.01047834163395578 -294.62170247515587107 5.127126749923851534 323.21555884047671725 -TestParticle -1.3065419938771187791 0.062752012732249048965 8.378519051225520542 -254.48399542766591708 227.28662992761130113 215.88914339840525258 -TestParticle -1.2803200151108913296 0.39024438031771679913 26.21206496548343523 -86.2004800657045962 86.508225331489853716 295.03587464294588472 -TestParticle -1.9599644739977994945 0.18082768987187250453 26.76260832548297941 -347.08076935823510212 187.06487585242066984 78.43547038210139988 -TestParticle -1.5504457817332411018 0.058138854268877486475 8.311304083318722391 -250.45953202370188251 51.58641776614162211 321.91182873943205323 -TestParticle -1.4030770961210228265 0.2255632436620616521 8.257376872662526068 -110.66653646497886143 331.8743125077128866 326.8827542847423615 -TestParticle -1.3330653778054313285 0.23576894818100968543 16.555280374134500931 -201.04570271621727784 304.9737571038722308 129.38177632189641031 -TestParticle -1.4676189305416613706 0.15334509742223720319 29.730324421851861416 -93.28877448580836074 98.24809064509591394 318.26221325804715434 -TestParticle -1.4959613849179316247 0.26490707510895572518 8.435591899110246317 -121.44478123997235741 352.46125426578402084 269.21443204906552182 -TestParticle -1.2410245922213516412 0.16484650483123386433 29.036807003172221187 -234.59702065989810649 212.29149699166657683 309.02229933747048563 -TestParticle -1.2104445735427551423 0.27493160452164350227 31.472614096909531156 -172.8652728002631136 303.96742459461654562 8.009940254088059319 -TestParticle -1.8791733750261010449 0.2587599416761243165 30.401845910812088647 -330.1151954343364423 190.20401433347646503 104.67843668270934643 -TestParticle -1.3013630074517779089 0.22413535954031660324 32.01650674239483152 -63.549710245898353378 35.89931403059021875 158.56811223007159128 -TestParticle -1.9547724398089645348 0.0786294356900830993 10.0598953139010802715 -69.4839845505388638 123.32244013516246639 31.421777442531322322 -TestParticle -1.6120256585797529958 0.19985700875898035345 13.999189942348966298 -78.857222386685961624 349.6556927780835622 58.475688092723309808 -TestParticle -1.7578912848822172421 0.27207852440462437782 21.16570903311817986 -204.48739950618715966 68.64871257741852162 227.95088374477833781 -TestParticle -1.8170356771723037426 0.24230078833019122464 19.368483713748780417 -184.73419610737784069 272.32723488431577152 126.891658495766833425 -TestParticle -1.8561231261283124283 0.19157748016708203709 1.1886704509024781373 -254.2676067727032887 317.6217024209003057 224.34445674903426493 -TestParticle -1.9710622679246994071 0.14623926742902368381 6.640292860769481109 -190.41063402021279671 187.773358994985756 328.47417804669458974 -TestParticle -1.8390376809348407683 0.39004880820775639227 20.066519467297950996 -211.93199248227401199 289.47815944254944043 137.15839269809171697 -TestParticle -1.6111502808558577637 0.22394676788626455277 20.061937046580968769 -92.54520491825057604 92.01310424807805077 13.375630065565452753 -TestParticle -1.7289359898596003973 0.029780688540387692531 26.014739049810341243 -312.66680607544742543 228.17665637399315415 125.22825394003517374 -TestParticle -1.2705682146072982963 0.029404610289824398284 5.561963728286389852 -84.16555574179947996 331.08838136349748993 315.88331119433712502 -TestParticle -1.8573347647002547145 0.36089888274309028793 33.45261607330014897 -108.58851164869084016 217.00073148209528995 139.41678117547121474 -TestParticle -1.5119662840275136517 0.035019622195022657996 10.463315222301648788 -152.85193304965602579 42.895445465204801394 38.742869188454783114 -TestParticle -1.7622884149632529471 0.03162410217369809179 3.1822974384423297067 -37.26277315140376345 107.89474442992022318 186.6015285726906825 -TestParticle -1.3516643515537363207 0.00042846679844568138443 14.013484979190140578 -216.76556913128737847 329.5425274371341402 157.99664633404185565 -TestParticle -1.3725976866577220825 0.30646538230027742244 11.329739671767651288 -198.97848141965863533 44.651190190469009167 28.049566579775078168 -TestParticle -1.4591070353626824918 0.08119659950059535114 34.28551752565069677 -306.99758279574081143 104.56005980026995417 24.491183217056139654 -TestParticle -1.6809883631745992094 0.12405907090243922797 23.088918298866115464 -81.89324756024211638 45.486408290411304733 5.9086829848113620045 -TestParticle -1.3535618238311779571 0.11072994226846155641 6.1365791065780417313 -96.5917090856876257 125.77992141224173395 180.26956152431557712 -TestParticle -1.5024996182012646528 0.2601294541852439135 20.11839589454453403 -270.4000045350792334 353.011762488246859 34.641037025004784766 -TestParticle -1.5996488376502526751 0.37889391086596613256 18.528995245881297649 -215.86591794372824893 196.33677334782890966 20.482598606365485239 -TestParticle -1.7931356901400370418 0.025945290910749509855 26.661454696830183764 -188.02499061598265939 217.74613305793528184 352.64512058062791766 -TestParticle -1.6808120166727305023 0.26627765088552390882 4.4798421923713638293 -12.471177251742290082 9.432555892002669751 336.72507040011447543 -TestParticle -1.6313081817828176678 0.0086570580622717507174 3.9083339029362873518 -54.248103250365730332 318.7038881970888724 331.85368591582181352 -TestParticle -1.2884450142579531029 0.1681046156164187344 35.34871223758726444 -240.5583121923978922 135.24748641897326706 301.64571007267852565 -TestParticle -1.9196539088974737819 0.055293464951134657648 39.174420254686374676 -13.003093109260595028 224.19261478871260351 272.9340647583842383 -TestParticle -1.3704960962475472019 0.11179773250371188853 23.81208520955706831 -261.70166394043076252 10.650163480395606896 96.095112534597603826 -TestParticle -1.9516781167723931123 0.20402034023295062548 32.535249468476067136 -340.51354688545097815 329.0040653030519593 109.98356406041511946 -TestParticle -1.8140222569343318337 0.12613518245266175377 1.4950171510413001741 -234.61793333937521311 320.05130111528796988 172.88154495883503614 -TestParticle -1.8102010682471065817 0.14811926068150899072 0.47152065059882453113 -231.56413706767099825 205.2503541540525589 214.7508917825621495 -TestParticle -1.3323729215149744398 0.19959213905409678436 1.3073421511548932727 -151.66443112411295147 341.31892085633529632 144.25232896171203834 -TestParticle -1.2204541150545651362 0.068668187712776870835 4.014281498324958619 -174.08147891950491726 47.939506002741296697 254.99017431971773817 -TestParticle -1.2181192459350491664 0.025059093817326606735 7.204862413525972009 -48.60770716273837877 329.11947000106135874 217.6643233891191187 -TestParticle -1.6039675062130638317 0.35797604454305875787 16.056969103103426733 -87.92417372221831329 49.76521958624503128 164.99398402032807098 -TestParticle -1.8725342069546249135 0.106279250804296898636 0.45718402173144045975 -119.596726134790174 107.86697924451233632 232.81352842822093407 -TestParticle -1.7853111973976689697 0.12193477571081268174 3.680789884957089697 -205.60326749430927862 40.207082764860338386 289.2290546833312419 -TestParticle -1.417950447978111761 0.24357413812980258094 1.910476157584461987 -252.61262373556786542 355.48333419302929315 151.32407206005677835 -TestParticle -1.2280461512973894767 0.15278421763439650749 26.714312283832946093 -142.72673485719965925 232.69712275301176874 346.3375478502677538 -TestParticle -1.61151127031616892 0.3744225370958842447 36.56793088861800811 -328.09520081336302155 25.920977978027824662 288.72452391776596414 -TestParticle -1.2239475600090146123 0.24714055634484358159 30.304522847333871027 -52.68180217169934565 356.99734588216864495 56.617981510557434888 -TestParticle -1.2496667763539286433 0.29747468986797759305 21.37154433932160913 -209.20331717962355356 22.663460638340339415 243.0475686976612053 -TestParticle -1.3767605238800932899 0.16005520292207792155 6.1854407103408437507 -301.0924331535983356 324.9040368073589775 194.17256664039328484 -TestParticle -1.2487797979186712194 0.16488755850697139893 27.605925256805747381 -173.22312758245544728 239.01695963206066153 175.97057379774636843 -TestParticle -1.2254722592225348876 0.36803675574552041638 17.169692704564543106 -198.47031096951334916 278.36167082537872375 125.492714298233096315 -TestParticle -1.6464965033862297705 0.1517233377674910566 13.532163365202411143 -147.08019388518567894 177.40254091222027455 340.04568453953692142 -TestParticle -1.2241673144222895431 0.1378443050280294957 35.034429639418924296 -279.5154571951889011 236.88366494050367805 224.20218590463449004 -TestParticle -1.7054405098540872388 0.3610118405579151868 11.466405393735001894 -354.5918155292421261 347.1596768668937898 219.93975816420154956 -TestParticle -1.7400094098497860262 0.11768201787113397039 3.0207223829180174235 -344.79550555000747636 295.17286383856117027 107.65817940211057646 -TestParticle -1.4518563888365596526 0.034369934761878086216 5.703231914559241389 -123.995036213356954136 112.321809800044363215 96.308678475290903975 -TestParticle -1.2222379634093671896 0.14278765376770935491 35.361595327244465636 -315.14729198154049072 321.37175810105372875 262.59992588280709924 -TestParticle -1.2388409450815878188 0.29191544705043231955 14.574148472908646568 -354.52890314367516567 301.2116870378684439 101.6607227628783221 -TestParticle -1.2004854536116522645 0.31759418786438237126 35.64893550976294989 -150.1713542262849046 263.81583006909363576 352.70617164487305217 -TestParticle -1.9942890442362894987 0.19536136516905414084 35.02451517807598691 -125.959361711604387324 266.3424034858336995 225.8398826035477498 -TestParticle -1.5915447637460526931 0.0895260552791858899 24.02901618574255238 -322.40268348510250007 115.71588659763698104 232.13880147735969217 -TestParticle -1.8790673483459361393 0.17433764017862168894 13.878215826572342095 -302.39495868122469346 259.03939837677381774 176.29569985086394013 -TestParticle -1.9699962554990502195 0.38438649317544010264 36.886012906803621547 -71.57770428256088735 76.46325818263683516 152.99488881347215852 -TestParticle -1.9815372834826587845 0.17262153411198999375 2.83353778898145503 -239.37167896200179484 354.1664112035709877 298.12866718881934958 -TestParticle -1.8155595191765212526 0.00946228278143057544 38.64106328673518931 -83.00268912398927057 67.39652732514183242 195.80213873516331091 -TestParticle -1.8868581896910789908 0.10440835820682173307 15.007174114646065988 -3.363490125056509683 163.21113577536885941 277.4874262071848534 -TestParticle -1.5619200947925855338 0.0059432103700412857936 28.417160713316764742 -199.61588156187738718 146.61610611302111806 239.63331133984317489 -TestParticle -1.5212478213877396183 0.39927753429172280208 20.482036387314252579 -328.51885419136107203 7.1256709736876455707 220.89114467811927511 -TestParticle -1.8571870020289564795 0.091291230530104086616 5.8118062401183578913 -90.75198382995706936 192.24228564818409382 97.133874093047666065 -TestParticle -1.9171289936627273764 0.15261088480197210204 38.10675746822411014 -307.07749448841616413 355.13520879558041088 42.711583491490678455 -TestParticle -1.7364144307839262105 0.212129283201967056 18.744823342299753222 -23.928680492317099038 37.437700592246308418 64.10777424122947821 -TestParticle -1.615801582218067356 0.15507189040762445198 5.289237911360147315 -2.9760090649453463385 170.77756092233224194 126.74171547116436898 -TestParticle -1.3071905708698117188 0.34127930871062794882 17.996264880013068677 -181.87012353589301483 211.32152679731703415 284.19737442691894103 -TestParticle -1.2265401930807908748 0.25798059801133454982 34.025699672304931198 -87.484085061199664324 233.26336671618474838 310.39211945198593412 -TestParticle -1.2051260378681512009 0.3069049294618042545 37.351493484362229935 -114.521127203859620636 225.6531083956228656 323.1220799515929798 -TestParticle -1.8334732437656884318 0.37979115889431414033 14.226342594064389502 -331.7883640504541063 109.06927231695421199 144.65450510058425948 -TestParticle -1.757300956926634683 0.03414936250768385584 23.912004140762192606 -322.3724083824729405 134.91275424426311247 171.32647169967813738 -TestParticle -1.8972253261023601656 0.35656552318718498507 28.47629514891832514 -321.29937216619140372 70.71608626545858556 213.57910706058532924 -TestParticle -1.9917616839747163127 0.32376104104249381344 8.91181936527569718 -200.88415597368361887 23.513470382909822831 100.72835347725671795 -TestParticle -1.6165777777920147251 0.32043762073249004718 16.726392824188689445 -319.72153811597894446 76.78830327849077264 138.42254101919101572 -TestParticle -1.8908331674281746437 0.045197492899151252288 1.3383682043347544521 -312.10875470237436957 307.494732749847401 43.074246036675127414 -TestParticle -1.2145287335503922588 0.18257617394552527745 31.629727041908243024 -3.7714421582542145828 327.9557064611080932 329.9790680610109348 -TestParticle -1.8625485962061800738 0.24850308301344462003 2.0061095060140976543 -276.90239618431269264 350.88215248164351578 348.2932770314767481 -TestParticle -1.7953658240966166026 0.23860504712104810277 30.564301023692120651 -268.6736542028508552 254.54176920249031468 269.62615941325310587 -TestParticle -1.8519636256102920413 0.13630536382454808142 25.429742406638986552 -78.06201903944463538 183.89412111638756642 25.670444097748280399 -TestParticle -1.9912586036233026476 0.0062934836627138949355 3.9866901191125192483 -353.92558378078365422 121.86076402069599567 272.13181013382109086 -TestParticle -1.2352461280314077641 0.13108872108404742707 2.4473753819670784893 -223.0667681463768588 134.42147854096177184 161.85468044136672461 -TestParticle -1.3431819133091436047 0.28681705477285673878 22.82513974594832007 -232.7183120134940566 120.199688171678360504 89.77367022064561297 -TestParticle -1.8403545873570172908 0.24879279733973019839 4.0287923881425502515 -15.018525270146003692 85.179302481017629134 62.783331763645470858 -TestParticle -1.381867054141263651 0.041622600218831219687 20.582798332241445394 -16.94221565894110526 117.67293863884100347 301.82514806956680786 -TestParticle -1.8641683600359446604 0.24640721081737218534 5.9107924107914655565 -193.20103651885807494 44.2323469313580091 26.743437036080784708 -TestParticle -1.966054790276180464 0.2690464178872462031 14.878455955491389773 -190.60763663869553852 31.588470897177995056 100.366806653161106055 -TestParticle -1.6058040413293108717 0.29951736276665757996 32.261171438174280013 -128.57574732488706104 32.785220122308132318 5.815690987139072732 -TestParticle -1.6218958057245982385 0.20051601410731448305 35.228407716619500434 -275.05072744657877593 300.36353903970075407 137.58872709072204543 -TestParticle -1.9766063717976680714 0.39029116187457174592 35.936563690886423217 -276.4677919812604614 334.4193480382128314 74.17428380404710708 -TestParticle -1.4924898153539933876 0.12959279079593266637 39.497773315041648345 -306.13052013355064673 297.98869981653200512 134.11781736074624405 -TestParticle -1.8353633188339963933 0.019510947086492525654 35.474352018859882207 -260.37806171878622763 151.50200809864463736 309.73656114784841975 -TestParticle -1.6024488136145134121 0.027272421536337843745 28.531535673798313013 -11.154644928392061232 313.60248630627489774 220.0912732804740699 -TestParticle -1.4120513432815475774 0.29969768596351453738 17.02938110092897972 -269.20328072337844105 42.08893931076963213 126.58679602124011865 -TestParticle -1.7381168022087705172 0.29181610891675680008 0.578376627518526476 -102.38820556898792802 176.55332025897169501 164.93491360823296077 -TestParticle -1.651697945678905155 0.10215579780054198644 29.466376982324295142 -118.66030632495935038 355.77634853151920424 138.86820482744579408 -TestParticle -1.8964095997568284346 0.14855799694311630499 39.315092089557069244 -66.7203702634703717 109.12901978076088483 150.07738642659984407 -TestParticle -1.5884778821144036609 0.34804404474317385265 8.230716828452404599 -238.65003666711348274 19.561503330036060788 172.3300970659766449 -TestParticle -1.4852533118509871901 0.14921150930008680868 19.72836045372870828 -214.04378603222667721 162.09311096493223658 74.70412564882457218 -TestParticle -1.3995786109265431207 0.2170751900351963748 5.6353499706781517986 -136.77890520256397622 41.74190372493747958 352.76491235469808316 -TestParticle -1.9228837399064100389 0.20666458127164555325 31.918474396874408683 -25.57157805855647581 146.61033704579944015 124.85803020390667939 -TestParticle -1.5491200767868975596 0.37703244317878858993 5.088593545490081027 -38.820500192778638393 121.37946795513649079 24.303500272632902579 -TestParticle -1.6942853977776144436 0.090260172320617615416 25.30769952267446854 -161.30886094388631591 116.98046667590497805 38.286029141363265182 -TestParticle -1.6090251866675413517 0.330322662148613444 9.770748848728519675 -263.0814719840412863 130.26024091675910199 286.9327501208536546 -TestParticle -1.9761336997553433648 0.2926123710566602143 11.274914096097191418 -332.1701813530870595 307.94382558508260672 353.807211256272808 -TestParticle -1.9968906969927759931 0.3233230682542853618 26.00314542561351061 -79.80693890771757992 308.2283099476609891 243.34005704939397674 -TestParticle -1.8031947344086236562 0.14995127116151910074 1.730342239053141995 -348.6351290160268377 154.3487630625562872 28.463371915640660603 -TestParticle -1.8395166633814701296 0.3354540599588180516 22.093131712634573205 -86.610640388957989444 239.4548535151652402 312.24619268529380633 -TestParticle -1.3629305527230259898 0.2099232743767838194 30.216497531918712127 -102.43196923936434928 291.32106047341460453 2.1370626980559981334 -TestParticle -1.7455726368986721475 0.026854653926422458743 3.5759919284920771432 -354.23018906949636175 218.20031690429203763 328.7114242710409826 -TestParticle -1.8154807930100198554 0.38785895954054117052 30.190244155261783732 -84.158791911543673336 145.33493614486761203 216.44848876198116727 -TestParticle -1.6499702946012431148 0.38233820338992924315 13.614607279413908358 -33.87451574095803153 90.770300669062208954 180.38849672518907141 -TestParticle -1.607515534627930176 0.059816004314718410062 35.188867073591850954 -58.61309722228839547 253.79649442362003242 91.30583916434224534 -TestParticle -1.9899983350379286673 0.30667218968608733753 39.83983478820580615 -209.92012615445401025 242.81573248914770602 7.221381167673248669 -TestParticle -1.5778501251334575706 0.11118331397677137795 37.590979480700937643 -345.16243909883007746 9.645072368649788785 50.426633047687808187 -TestParticle -1.8837383001263663385 0.20673789324487820696 21.972954461156501083 -78.99100998693006659 24.805859834858065227 136.69965104577451598 -TestParticle -1.8299552552499931402 0.18024309648678646378 33.71418287836082328 -287.1584786318022111 76.47733005592756683 216.63675723929046057 -TestParticle -1.8307526657330810416 0.27679256938591745296 14.42019596286409211 -147.28115682985833246 236.20842913390856666 70.36203841533576053 -TestParticle -1.7619978997528076281 0.014257923627121950327 18.454020582426768016 -275.7628626446463045 152.24331061485040095 103.04339508992384822 -TestParticle -1.2611641121223651218 0.2092199031608525106 17.779518579686019564 -102.7504319389703511 6.548313747168017507 140.31125376249352144 -TestParticle -1.7663975820756958601 0.25859601590736014387 19.29766354922654159 -228.43411110252168328 129.52408847472079856 44.31277736443019677 -TestParticle -1.3455298896696588073 0.051640741433284009787 36.190409530870716992 -63.492703118667094486 178.32472671129730202 219.22272979662204762 -TestParticle -1.8502619397752217978 0.016055258128672856427 24.72292322260771158 -280.24156788062276746 1.0103622910431475646 89.91460784296667441 -TestParticle -1.7394822607661057923 0.13625236700994178274 8.773342269773106494 -131.40116141700701746 79.224373058834927974 282.8109557650995498 -TestParticle -1.6325195629104731765 0.16262358056449152666 8.946438635142083484 -196.95655091099223455 13.582007343579313385 258.10561033792743046 -TestParticle -1.7657479077259037314 0.21823895457628741945 26.194016006374575056 -307.4759621278849977 98.40357006941655982 64.08127327032266862 -TestParticle -1.3184659717472237972 0.20902078438144011674 11.194180638539418027 -209.8144125213535176 233.63319375255508703 171.85375675646986338 -TestParticle -1.6265974791221389228 0.3412246124964996019 31.920108006714791316 -47.471005836654683208 293.97130420183299293 294.00277926085681202 -TestParticle -1.544562457381803755 0.26456236803106419897 16.966290843319804083 -53.617851002077699718 23.906897211735604003 172.46215455198040445 -TestParticle -1.8302658298265410686 0.016558573352333152279 23.88277176507106958 -160.31985284355113208 24.957240748542652398 126.6630513998358083 -TestParticle -1.6333356556090419254 0.25338625439533907224 11.051395862722980468 -182.26698944663951352 1.9926145156870767039 206.81766326774084064 -TestParticle -1.2674061997735568408 0.09083958911004344494 16.414033820600888447 -209.7777498397578313 350.73333597951523188 247.44407246182404947 -TestParticle -1.400118114272113079 0.16683948053104513676 27.357400210939808005 -107.57418681944162131 96.46599300991492498 351.137614793950263 -TestParticle -1.542911801971112773 0.22704910395233757203 35.542775761322914718 -183.89056710921508397 326.93869125935344755 108.004775809479497184 -TestParticle -1.8076126800363871983 0.3514591336111956288 31.06364189291468847 -32.09942049648420692 328.34181095498098557 23.785841162187210784 -TestParticle -1.7657364621109161718 0.22171357606490707526 37.37986273837123008 -76.229451450918475075 186.15095789038804241 272.82850857627113328 -TestParticle -1.5339591135633763308 0.14194102156165430695 16.888317976342129612 -130.44976850069960506 252.36020783978619875 120.456187175611859175 -TestParticle -1.9547780848567972711 0.20899592311387996113 28.868044731219395516 -228.48529363010104021 342.5481929867736426 287.9707078087696459 -TestParticle -1.2418423098941544502 0.2626072565929837288 2.1074243271891202056 -38.080338719023941962 119.27817821310316049 12.056891938029119515 -TestParticle -1.2210546528534078625 0.3775561742151631872 22.111051712315155982 -338.55211294801040367 12.980519500186410653 332.2853401701941607 -TestParticle -1.5963937431999124517 0.23239324239635986147 13.194381854516867847 -58.007673822576016676 88.15306827351753327 155.81366075873469867 -TestParticle -1.5786275082915319778 0.025562551186680871479 4.998454237047265103 -250.39244849302215812 165.61747690949906087 149.37807874408460407 -TestParticle -1.6098684422151645634 0.21941479472017652586 38.283886043658093 -237.71100658433758213 47.01387761056833625 340.9146849041053997 -TestParticle -1.294274143429140933 0.3692138815235402327 37.966030890732696434 -203.45477640609851733 296.29180039237496658 44.323085276308532343 -TestParticle -1.5889819356899443914 0.084869830381732264124 1.0823445911213003257 -301.3291216497269147 146.81272157061789585 2.2993592847625343722 -TestParticle -1.495972566018333838 0.2617122471497527747 13.094048981160977263 -112.72021003020111607 127.77611875010921949 296.87288781423353612 -TestParticle -1.9818950278621338956 0.30723187525460954328 2.2340086246482782073 -253.14761844363803789 165.37409022827591798 191.3408807414710111 -TestParticle -1.7869956116636900312 0.045787597413756889186 8.90426427671208387 -227.8168631112827427 149.58799389390406986 24.858909708161100127 -TestParticle -1.9448897771198014883 0.05694944930378804948 36.311102677736613487 -84.3756745725393813 14.735521995724774058 314.16923571788140634 -TestParticle -1.5778886440600849994 0.054612245238724765883 16.72994958727242576 -293.0541083071825028 260.48271034952341552 308.15802194547808313 -TestParticle -1.3022587146281570103 0.26839233124203137892 18.02838057643581493 -293.20763835009915965 312.4703557364094877 106.58503108046902241 -TestParticle -1.8428500612922003032 0.23594727253001890332 11.315478566151577766 -9.262284156503813648 11.174441070760416039 331.91331034768620611 -TestParticle -1.2400313949450130213 0.37422492957960290516 16.60903446615966672 -240.33042266148279964 153.97322107823731585 191.41559045744850209 -TestParticle -1.9829274684920319416 0.3634611481375451536 25.819601695264427832 -140.99742244780588862 341.49734482956387183 8.731842495851447339 -TestParticle -1.9975413987753882772 0.06592938413948253029 39.49276861893206103 -67.714562888696974596 98.14914061512281762 45.19626721853934015 -TestParticle -1.2436383625451867818 0.3204615517738288455 26.461603913930925813 -266.5125426106603186 127.50909218237357834 0.3132830361456928614 -TestParticle -1.4113215699552892346 0.009827894395237192146 37.858626352737367426 -253.23691224458718807 108.52674294880429784 352.47828245113328194 -TestParticle -1.8148473149676069838 0.017705697189401049807 27.03434752366788274 -244.97100671505916125 96.848173936006702434 232.97923224763914618 -TestParticle -1.8212512693609279602 0.27211932176121911287 4.7578666520375545446 -347.57353058021692505 254.19838041200335965 6.6604121361125034895 -TestParticle -1.6430443076417013959 0.042365150738876616865 28.313700526240026534 -178.6338948507659552 287.94750707892865194 146.775946581025039 -TestParticle -1.2047662238103988841 0.23251833898522478172 17.70944339203029827 -282.07165060128687628 43.193800331112015556 189.58232124886598058 -TestParticle -1.2467705317577537638 0.29356902400030004952 2.8706191725519047964 -242.4004033144470327 28.806681869090574821 296.21360336099968436 -TestParticle -1.3162696178512978129 0.30749173225083181737 9.346008763094072691 -322.38053647407821245 112.34526406313270286 132.09084683753127365 -TestParticle -1.2971409174950825349 0.3376994788613812415 24.652899562822732094 -299.7803539105363484 271.40817959188655095 266.8572235615602608 -TestParticle -1.7684747977650516759 0.02661749740193952718 10.096507324045376208 -3.7221406213358587678 125.36494422546940086 238.11022628505401144 -TestParticle -1.8562458518793771844 0.077017667000931988586 8.7143363020037831745 -136.69548804548151111 320.94977656886021578 128.10172157330882214 -TestParticle -1.5044816034257817439 0.21762930629061374987 27.505997823490588416 -123.58136898241176027 187.9229325893226985 113.043904522795230605 -TestParticle -1.7868133877825629341 0.008087932404090647162 23.413784625415864582 -218.89711766597091014 88.56442540385896223 208.43834176513581724 -TestParticle -1.9402143213090712326 0.14949494785208861103 26.511808095563488052 -107.604663311176523166 130.69889435502176411 346.87469017336604793 -TestParticle -1.5966683044291980487 0.087101617604941061757 35.919427778579809285 -212.8714684966646189 289.47277777746671745 150.30140968266374557 -TestParticle -1.5311077130660335488 0.006686025386596972271 2.6738949911861054076 -164.51009812173990099 316.04513748492058767 258.44750388729431734 -TestParticle -1.327174430660648996 0.16386649979480424899 29.516591637239059764 -42.47034129892313814 297.69030488053482486 179.48650722792217493 -TestParticle -1.3309285665414212207 0.31056216374123679635 33.20416058697580297 -182.12327311281021025 179.4712707903883313 47.404071121072391293 -TestParticle -1.2695626979113197041 0.028739588397623319627 34.7510196296938787 -156.66911337647667324 15.489917584647256987 137.9360720619328049 -TestParticle -1.961564416777008768 0.38198101311209609054 20.407128195470789933 -116.450533784431996764 317.3401517067230202 183.14633665136960872 -TestParticle -1.5940513845582582331 0.25613384894831064953 29.533539385317940429 -118.85654306899444066 250.92868906503659332 22.448371873007765487 -TestParticle -1.8442908242187292522 0.19455300058304564326 38.64468812151265098 -327.51192512776293597 261.15575066638751878 220.98151223015130995 -TestParticle -1.9551136736888132805 0.05881060116092867024 0.025983316883650964257 -229.51441899139550173 217.59860795663826138 108.775137355673251705 -TestParticle -1.3586578999851930405 0.34983150673028151623 31.522812174550345787 -105.68138198042714748 123.58623362447058014 40.330126317320825535 -TestParticle -1.902888826244875764 0.13683561730200419215 16.275257623666469442 -105.98161437435868493 148.2954616585051042 301.45848496238744474 -TestParticle -1.4388714351119729074 0.12902603848379340379 21.287394563627660915 -197.02123109899764586 352.44807359808243064 351.33034912544712824 -TestParticle -1.6931112006676685144 0.013916379702603532201 0.7871365555378062595 -188.64764325380838272 181.38199447667832942 29.813972851285797105 -TestParticle -1.6449616174898105125 0.0310490777007133463 9.657476944838542465 -333.95122687579464582 342.1511167418379955 160.69927097810261785 -TestParticle -1.432310913839848876 0.006987746683723328363 32.61241995358341228 -207.28809337462874396 169.31652720575732474 255.68956575096319739 -TestParticle -1.7327468488118134005 0.03857017036911090241 17.468015575192744393 -143.82903277012908916 99.60548209763706495 166.68173997089294858 -TestParticle -1.5512315858530165702 0.17035757433763087931 28.229428870918749084 -211.42236583345217582 136.37631347760083145 126.78807511085641124 -TestParticle -1.5128716646861577466 0.25892751799964647264 10.396770119409808331 -251.02700694813202631 225.21225462676682127 190.02303419914397864 -TestParticle -1.3509296764855895923 0.19460583033279599263 25.473407765343523579 -153.07999025709941066 160.34541100643662048 39.661129674485906094 -TestParticle -1.6995982689149604639 0.3683946534553529384 13.407331577384432819 -340.26004127001408506 272.0620153240722061 254.6289696923701058 -TestParticle -1.4262589721598459835 0.39380044551624404647 22.273999686412832233 -126.6676609334621304 343.6417878124360641 356.69746962842407356 -TestParticle -1.3261721625529891977 0.39678878113200655164 4.2056417606931040254 -238.10434769519417841 155.06469638647084253 44.875703119243368633 -TestParticle -1.9576977154420573957 0.26084185228864192885 4.55948470669549355 -190.48438127706978662 33.209683105017965943 111.270270586090106235 -TestParticle -1.8552016088932457016 0.13548857795579999364 39.778098090381654117 -36.82048012699509343 277.63542496441021967 284.2017295471840157 -TestParticle -1.6904488396185337606 0.10545628795963413182 32.08178306599211993 -75.246216623590498784 230.69409080017558722 202.52540071832260082 -TestParticle -1.8262524413841534354 0.33415074562628183097 12.176323543258451565 -135.12569593248673527 273.69848190668875532 306.5447498396289916 diff --git a/examples/whm_gr_test/.gitignore b/examples/whm_gr_test/.gitignore new file mode 100644 index 000000000..1463c046c --- /dev/null +++ b/examples/whm_gr_test/.gitignore @@ -0,0 +1,3 @@ +* +!.gitignore +!whm_gr_test.py \ No newline at end of file diff --git a/examples/whm_gr_test/whm_gr_test.py b/examples/whm_gr_test/whm_gr_test.py new file mode 100644 index 000000000..ee66558d2 --- /dev/null +++ b/examples/whm_gr_test/whm_gr_test.py @@ -0,0 +1,103 @@ +""" + 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. +""" + +#!/usr/bin/env python3 +""" +Generates and runs two sets of Swiftest input files from initial conditions with the WHM integrator. All simulation +outputs for the general relativity run are stored in the /gr subdirectory while all simulation outputs for the run +without general reelativity are stored in the /nogr subdirectory. + +Input +------ +None. + +Output +------ +whm_gr_mercury_precession.png : Portable Network Graphic file depicting the precession of Mercury's perihelion over time + with data sourced from the JPL Horizons database, Swiftest run with general relativity, + and Swiftest run without general relativity. + +Two subdirectories: +gr/ +nogr/ + +Each subdirecotry contains: +data.nc : A NetCDF file containing the simulation output. +dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +init_cond.nc : A NetCDF file containing the initial conditions for the simulation. +dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. +dump_param2.in : An ASCII file containing the necessary parameters to restart a simulation. +param.in : An ASCII file containing the parameters for the simulation. +swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. +""" + +import swiftest +from astroquery.jplhorizons import Horizons +import datetime +import numpy as np +import matplotlib.pyplot as plt + +# Initialize the simulation object as a variable. Define the directory in which the output will be placed. +sim_gr = swiftest.Simulation(simdir="gr") +sim_gr.add_solar_system_body(["Sun","Mercury","Venus","Earth","Mars","Jupiter","Saturn","Uranus","Neptune"]) + +# Initialize the simulation object as a variable. Define the directory in which the output will be placed. +sim_nogr = swiftest.Simulation(simdir="nogr") +sim_nogr.add_solar_system_body(["Sun","Mercury","Venus","Earth","Mars","Jupiter","Saturn","Uranus","Neptune"]) + +# Define a set of arguments that apply to both runs. For a list of possible arguments, see the User Manual. +run_args = {"tstop":1000.0, "dt":0.005, "tstep_out":10.0, "dump_cadence": 0,"integrator":"whm"} + +# Run both simulations. +sim_gr.run(**run_args,general_relativity=True) +sim_nogr.run(**run_args,general_relativity=False) + +# Get the start and end date of the simulation so we can compare with the real solar system. +start_date = sim_gr.ephemeris_date +tstop_d = sim_gr.param['TSTOP'] * sim_gr.param['TU2S'] / swiftest.JD2S + +stop_date = (datetime.datetime.fromisoformat(start_date) + datetime.timedelta(days=tstop_d)).isoformat() + +#Get the ephemerides of Mercury for the same timeframe as the simulation. +obj = Horizons(id='1', location='@sun', + epochs={'start':start_date, 'stop':stop_date, + 'step':'10y'}) +el = obj.elements() +t = (el['datetime_jd']-el['datetime_jd'][0]) / 365.25 +varpi_obs = el['w'] + el['Omega'] + +varpisim_gr= sim_gr.data['varpi'].sel(name="Mercury") +varpisim_nogr= sim_nogr.data['varpi'].sel(name="Mercury") +tsim = sim_gr.data['time'] + +dvarpi_gr = np.diff(varpisim_gr) * 3600 * 100 / run_args['tstep_out'] +dvarpi_nogr = np.diff(varpisim_nogr) * 3600 * 100 / run_args['tstep_out'] +dvarpi_obs = np.diff(varpi_obs) / np.diff(t) * 3600 * 100 + +# Plot of the data and save the output plot. +fig, ax = plt.subplots() + +ax.plot(t, varpi_obs, label="JPL Horizons",linewidth=2.5) +ax.plot(tsim, varpisim_gr, label="Swiftest WHM GR",linewidth=1.5) +ax.plot(tsim, varpisim_nogr, label="Swiftest WHM No GR",linewidth=1.5) +ax.set_xlabel('Time (y)') +ax.set_ylabel('Mercury $\\varpi$ (deg)') +ax.legend() +plt.savefig("whm_gr_mercury_precession.png",dpi=300) + +# Print the data to the terminal. +print('Mean precession rate for Mercury long. peri. (arcsec/100 y)') +print(f'JPL Horizons : {np.mean(dvarpi_obs)}') +print(f'Swiftest No GR : {np.mean(dvarpi_nogr)}') +print(f'Swiftest GR : {np.mean(dvarpi_gr)}') +print(f'Obs - Swiftest GR : {np.mean(dvarpi_obs - dvarpi_gr)}') +print(f'Obs - Swiftest No GR : {np.mean(dvarpi_obs - dvarpi_nogr)}') diff --git a/python/swiftest/swiftest/constants.py b/python/swiftest/swiftest/constants.py index 5bd5bc7a4..2d3f89f7c 100644 --- a/python/swiftest/swiftest/constants.py +++ b/python/swiftest/swiftest/constants.py @@ -13,15 +13,18 @@ import astropy.constants as const # Constants in SI units -GC = np.longdouble(const.G.value) -AU2M = np.longdouble(const.au.value) -GMSunSI = np.longdouble(const.GM_sun.value) -MSun = np.longdouble(const.M_sun.value) -RSun = np.longdouble(const.R_sun.value) +GC = const.G.value[()] +AU2M = const.au.value +GMSun = const.GM_sun.value +MSun = const.M_sun.value +RSun = const.R_sun.value +MEarth = const.M_earth.value +REarth = const.R_earth.value +GMEarth = const.GM_earth.value JD2S = 86400 -YR2S = np.longdouble(365.25 * JD2S) -einsteinC = np.longdouble(299792458.0) +YR2S = 365.25 * JD2S +einsteinC = 299792458.0 # Solar oblatenes values: From Mecheri et al. (2004), using Corbard (b) 2002 values (Table II) -J2Sun = np.longdouble(2.198e-7) -J4Sun = np.longdouble(-4.805e-9) +J2Sun = 2.198e-7 +J4Sun = -4.805e-9 diff --git a/python/swiftest/swiftest/init_cond.py b/python/swiftest/swiftest/init_cond.py index 78ef51be9..02ff6f8e1 100644 --- a/python/swiftest/swiftest/init_cond.py +++ b/python/swiftest/swiftest/init_cond.py @@ -8,17 +8,26 @@ You should have received a copy of the GNU General Public License along with Swiftest. If not, see: https://www.gnu.org/licenses. """ +from __future__ import annotations import swiftest import numpy as np +import numpy.typing as npt from astroquery.jplhorizons import Horizons import astropy.units as u from astropy.coordinates import SkyCoord import datetime -from datetime import date import xarray as xr - -def solar_system_horizons(plname, idval, param, ephemerides_start_date, ds): +from typing import ( + Literal, + Dict, + List, + Any +) +def solar_system_horizons(name: str, + param: Dict, + ephemerides_start_date: str, + id: int | None = None): """ Initializes a Swiftest dataset containing the major planets of the Solar System at a particular data from JPL/Horizons @@ -28,8 +37,6 @@ def solar_system_horizons(plname, idval, param, ephemerides_start_date, ds): Swiftest paramuration parameters. This method uses the unit conversion factors to convert from JPL's AU-day system into the system specified in the param file ephemerides_start_date : string Date to use when obtaining the ephemerides in the format YYYY-MM-DD. - ds : xarray Dataset - Dataset to append Returns ------- @@ -49,14 +56,14 @@ def solar_system_horizons(plname, idval, param, ephemerides_start_date, ds): 'Pluto': '9' } - if plname in planetid: + if name in planetid: ispl = True - idval = planetid[plname] + id = planetid[name] else: ispl = False - print(f"\nMassive body {plname} not found or not yet supported") + print(f"\nMassive body {name} not found or not yet supported") print("This will be created as a massless test particle") - if idval is None: + if id is None: print("ID value required for this input type") return @@ -120,48 +127,47 @@ def solar_system_horizons(plname, idval, param, ephemerides_start_date, ds): THIRDLONG = np.longdouble(1.0) / np.longdouble(3.0) # Central body value vectors - GMcb = np.array([swiftest.GMSunSI * param['TU2S'] ** 2 / param['DU2M'] ** 3]) - Rcb = np.array([swiftest.RSun / param['DU2M']]) - J2RP2 = np.array([swiftest.J2Sun * (swiftest.RSun / param['DU2M']) ** 2]) - J4RP4 = np.array([swiftest.J4Sun * (swiftest.RSun / param['DU2M']) ** 4]) + GMcb = swiftest.GMSun * param['TU2S'] ** 2 / param['DU2M'] ** 3 + Rcb = swiftest.RSun / param['DU2M'] + J2RP2 = swiftest.J2Sun * (swiftest.RSun / param['DU2M']) ** 2 + J4RP4 = swiftest.J4Sun * (swiftest.RSun / param['DU2M']) ** 4 solarpole = SkyCoord(ra=286.13 * u.degree, dec=63.87 * u.degree) solarrot = planetrot['Sun'] * param['TU2S'] rotcb = solarpole.cartesian * solarrot + rotcb = np.array([rotcb.x.value, rotcb.y.value, rotcb.z.value]) Ipsun = np.array([0.0, 0.0, planetIpz['Sun']]) param_tmp = param param_tmp['OUT_FORM'] = 'XVEL' - if plname == "Sun" : # Create central body + rh = np.full(3,np.nan) + vh = np.full(3,np.nan) + a = None + e = None + inc = None + capom = None + omega = None + capm = None + Ip = np.full(3,np.nan) + rot = np.full(3,np.nan) + rhill = None + Gmass = None + Rpl = None + J2 = None + J4 = None + + if name == "Sun" : # Create central body print("Creating the Sun as a central body") - v1 = None - v2 = None - v3 = None - v4 = None - v5 = None - v6 = None - rhill = None - GMpl = GMcb + Gmass = GMcb Rpl = Rcb J2 = J2RP2 J4 = J4RP4 - if param['ROTATION'] == 'YES': - Ip1 = [Ipsun[0]] - Ip2 = [Ipsun[1]] - Ip3 = [Ipsun[2]] - rotx = [rotcb.x] - roty = [rotcb.y] - rotz = [rotcb.z] - else: - Ip1 = None - Ip2 = None - Ip3 = None - rotx = None - roty = None - rotz = None + if param['ROTATION']: + Ip = Ipsun + rot = rotcb else: # Fetch solar system ephemerides from Horizons - print(f"Fetching ephemerides data for {plname} from JPL/Horizons") + print(f"Fetching ephemerides data for {name} from JPL/Horizons") # Horizons date time internal variables tstart = datetime.date.fromisoformat(ephemerides_start_date) @@ -170,88 +176,57 @@ def solar_system_horizons(plname, idval, param, ephemerides_start_date, ds): ephemerides_end_date = tend.isoformat() ephemerides_step = '1d' - v1 = [] - v2 = [] - v3 = [] - v4 = [] - v5 = [] - v6 = [] - J2 = None - J4 = None - pldata = {} - pldata[plname] = Horizons(id=idval, location='@sun', + pldata[name] = Horizons(id=id, location='@sun', epochs={'start': ephemerides_start_date, 'stop': ephemerides_end_date, 'step': ephemerides_step}) if param['IN_FORM'] == 'XV': - v1.append(pldata[plname].vectors()['x'][0] * DCONV) - v2.append(pldata[plname].vectors()['y'][0] * DCONV) - v3.append(pldata[plname].vectors()['z'][0] * DCONV) - v4.append(pldata[plname].vectors()['vx'][0] * VCONV) - v5.append(pldata[plname].vectors()['vy'][0] * VCONV) - v6.append(pldata[plname].vectors()['vz'][0] * VCONV) + rx = pldata[name].vectors()['x'][0] * DCONV + ry = pldata[name].vectors()['y'][0] * DCONV + rz = pldata[name].vectors()['z'][0] * DCONV + vx = pldata[name].vectors()['vx'][0] * VCONV + vy = pldata[name].vectors()['vy'][0] * VCONV + vz = pldata[name].vectors()['vz'][0] * VCONV + + rh = np.array([rx,ry,rz]) + vh = np.array([vx,vy,vz]) elif param['IN_FORM'] == 'EL': - v1.append(pldata[plname].elements()['a'][0] * DCONV) - v2.append(pldata[plname].elements()['e'][0]) - v3.append(pldata[plname].elements()['incl'][0]) - v4.append(pldata[plname].elements()['Omega'][0]) - v5.append(pldata[plname].elements()['w'][0]) - v6.append(pldata[plname].elements()['M'][0]) + a = pldata[name].elements()['a'][0] * DCONV + e = pldata[name].elements()['e'][0] + inc = pldata[name].elements()['incl'][0] + capom = pldata[name].elements()['Omega'][0] + omega = pldata[name].elements()['w'][0] + capm = pldata[name].elements()['M'][0] if ispl: - GMpl = [] - GMpl.append(GMcb[0] / MSun_over_Mpl[plname]) - if param['CHK_CLOSE'] == 'YES': - Rpl = [] - Rpl.append(planetradius[plname] * DCONV) - else: - Rpl = None + Gmass = GMcb / MSun_over_Mpl[name] + if param['CHK_CLOSE']: + Rpl = planetradius[name] * DCONV # Generate planet value vectors - if (param['RHILL_PRESENT'] == 'YES'): - rhill = [] - rhill.append(pldata[plname].elements()['a'][0] * DCONV * (3 * MSun_over_Mpl[plname]) ** (-THIRDLONG)) - else: - rhill = None - if (param['ROTATION'] == 'YES'): - Ip1 = [] - Ip2 = [] - Ip3 = [] - rotx = [] - roty = [] - rotz = [] - RA = pldata[plname].ephemerides()['NPole_RA'][0] - DEC = pldata[plname].ephemerides()['NPole_DEC'][0] + if (param['RHILL_PRESENT']): + rhill = pldata[name].elements()['a'][0] * DCONV * (3 * MSun_over_Mpl[name]) ** (-THIRDLONG) + + if (param['ROTATION']): + RA = pldata[name].ephemerides()['NPole_RA'][0] + DEC = pldata[name].ephemerides()['NPole_DEC'][0] rotpole = SkyCoord(ra=RA * u.degree, dec=DEC * u.degree) - rotrate = planetrot[plname] * param['TU2S'] + rotrate = planetrot[name] * param['TU2S'] rot = rotpole.cartesian * rotrate - Ip = np.array([0.0, 0.0, planetIpz[plname]]) - Ip1.append(Ip[0]) - Ip2.append(Ip[1]) - Ip3.append(Ip[2]) - rotx.append(rot.x) - roty.append(rot.y) - rotz.append(rot.z) - else: - Ip1 = None - Ip2 = None - Ip3 = None - rotx = None - roty = None - rotz = None + rot = np.array([rot.x.value, rot.y.value, rot.z.value]) + Ip = np.array([0.0, 0.0, planetIpz[name]]) + else: - GMpl = None + Gmass = None - if idval is None: - plid = np.array([planetid[plname]], dtype=int) - else: - plid = np.array([idval], dtype=int) + if id is None: + id = planetid[name] - return plid,[plname],v1,v2,v3,v4,v5,v6,GMpl,Rpl,rhill,Ip1,Ip2,Ip3,rotx,roty,rotz,J2,J4 + return id,name,a,e,inc,capom,omega,capm,rh,vh,Gmass,Rpl,rhill,Ip,rot,J2,J4 -def vec2xr(param, idvals, namevals, v1, v2, v3, v4, v5, v6, GMpl=None, Rpl=None, rhill=None, Ip1=None, Ip2=None, Ip3=None, rotx=None, roty=None, rotz=None, J2=None, J4=None,t=0.0): +def vec2xr(param: Dict, **kwargs: Any): """ Converts and stores the variables of all bodies in an xarray dataset. @@ -259,162 +234,77 @@ def vec2xr(param, idvals, namevals, v1, v2, v3, v4, v5, v6, GMpl=None, Rpl=None, ---------- param : dict Swiftest paramuration parameters. - idvals : integer - Array of body index values. - namevals : - - v1 : array of floats - xh - v2 : array of floats - yh - v3 : array of floats - zh - v4 : array of floats - vhxh - v5 : array of floats - vhyh - v6 : array of floats - vhzh - GMpl : array of floats - G*mass - Rpl : array of floats - radius - rhill : array of floats - Hill Radius - Ip1 : array of floats - Principal axes moments of inertia - Ip2 : array of floats - Principal axes moments of inertia - Ip3 : array of floats - Principal axes moments of inertia - rox : array of floats - Rotation rate vector - roty : array of floats - Rotation rate vector - rotz : array of floats - Rotation rate vector - t : array of floats + name : str or array-like of str, optional + Name or names of Bodies. If none passed, name will be "Body" + id : int or array-like of int, optional + Unique id values. If not passed, an id will be assigned in ascending order starting from the pre-existing + Dataset ids. + a : float or array-like of float, optional + semimajor axis for param['IN_FORM'] == "EL" + e : float or array-like of float, optional + eccentricity for param['IN_FORM'] == "EL" + inc : float or array-like of float, optional + inclination for param['IN_FORM'] == "EL" + capom : float or array-like of float, optional + longitude of periapsis for param['IN_FORM'] == "EL" + omega : float or array-like of float, optional + argument of periapsis for param['IN_FORM'] == "EL" + capm : float or array-like of float, optional + mean anomaly for param['IN_FORM'] == "EL" + rh : (n,3) array-like of float, optional + Position vector array. This can be used instead of passing v1, v2, and v3 sepearately for "XV" input format + vh : (n,3) array-like of float, optional + Velocity vector array. This can be used instead of passing v4, v5, and v6 sepearately for "XV" input format + Gmass : float or array-like of float, optional + G*mass values if these are massive bodies (only one of mass or Gmass can be passed) + radius : float or array-like of float, optional + Radius values if these are massive bodies + rhill : float or array-like of float, optional + Hill's radius values if these are massive bodies + rot: (n,3) array-like of float, optional + Rotation rate vectors if these are massive bodies with rotation enabled. This can be used instead of passing + Ip: (n,3) array-like of flaot, optional + Principal axes moments of inertia vectors if these are massive bodies with rotation enabled. This can be used + instead of passing Ip1, Ip2, and Ip3 separately + time : array of floats Time at start of simulation Returns ------- ds : xarray dataset """ - if v1 is None: # This is the central body - iscb = True - else: - iscb = False + scalar_dims = ['id'] + vector_dims = ['id','space'] + space_coords = np.array(["x","y","z"]) - if param['ROTATION'] == 'YES': - if Ip1 is None: - Ip1 = np.full_like(v1, 0.4) - if Ip2 is None: - Ip2 = np.full_like(v1, 0.4) - if Ip3 is None: - Ip3 = np.full_like(v1, 0.4) - if rotx is None: - rotx = np.full_like(v1, 0.0) - if roty is None: - roty = np.full_like(v1, 0.0) - if rotz is None: - rotz = np.full_like(v1, 0.0) - - dims = ['time', 'id', 'vec'] - infodims = ['id', 'vec'] - if not iscb and GMpl is not None: - ispl = True - else: - ispl = False - - if ispl and param['CHK_CLOSE'] == 'YES' and Rpl is None: - print("Massive bodies need a radius value.") - return None - if ispl and rhill is None and param['RHILL_PRESENT'] == 'YES': - print("rhill is required.") - return None - - # Be sure we use the correct input format - old_out_form = param['OUT_FORM'] - param['OUT_FORM'] = param['IN_FORM'] - clab, plab, tlab, infolab_float, infolab_int, infolab_str = swiftest.io.make_swiftest_labels(param) - param['OUT_FORM'] = old_out_form - vec_str = np.vstack([namevals]) - label_str = ["name"] - if iscb: - label_float = clab.copy() - vec_float = np.vstack([GMpl,Rpl,J2,J4]) - if param['ROTATION'] == 'YES': - vec_float = np.vstack([vec_float, Ip1, Ip2, Ip3, rotx, roty, rotz]) - particle_type = "Central Body" - else: - vec_float = np.vstack([v1, v2, v3, v4, v5, v6]) - if ispl: - label_float = plab.copy() - vec_float = np.vstack([vec_float, GMpl]) - if param['CHK_CLOSE'] == 'YES': - vec_float = np.vstack([vec_float, Rpl]) - if param['RHILL_PRESENT'] == 'YES': - vec_float = np.vstack([vec_float, rhill]) - if param['ROTATION'] == 'YES': - vec_float = np.vstack([vec_float, Ip1, Ip2, Ip3, rotx, roty, rotz]) - particle_type = np.repeat("Massive Body",idvals.size) - else: - label_float = tlab.copy() - particle_type = np.repeat("Test Particle",idvals.size) - origin_type = np.repeat("User Added Body",idvals.size) - origin_time = np.full_like(v1,t) - collision_id = np.full_like(idvals,0) - origin_xhx = v1 - origin_xhy = v2 - origin_xhz = v3 - origin_vhx = v4 - origin_vhy = v5 - origin_vhz = v6 - discard_time = np.full_like(v1,-1.0) - status = np.repeat("ACTIVE",idvals.size) - discard_xhx = np.zeros_like(v1) - discard_xhy = np.zeros_like(v1) - discard_xhz = np.zeros_like(v1) - discard_vhx = np.zeros_like(v1) - discard_vhy = np.zeros_like(v1) - discard_vhz = np.zeros_like(v1) - discard_body_id = np.full_like(idvals,-1) - info_vec_float = np.vstack([ - origin_time, - origin_xhx, - origin_xhy, - origin_xhz, - origin_vhx, - origin_vhy, - origin_vhz, - discard_time, - discard_xhx, - discard_xhy, - discard_xhz, - discard_vhx, - discard_vhy, - discard_vhz]) - info_vec_int = np.vstack([collision_id, discard_body_id]) - info_vec_str = np.vstack([particle_type, origin_type, status]) - frame_float = info_vec_float.T - frame_int = info_vec_int.T - frame_str = info_vec_str.T - if param['IN_TYPE'] == 'NETCDF_FLOAT': - ftype=np.float32 - elif param['IN_TYPE'] == 'NETCDF_DOUBLE' or param['IN_TYPE'] == 'ASCII': - ftype=np.float64 - da_float = xr.DataArray(frame_float, dims=infodims, coords={'id': idvals, 'vec': infolab_float}).astype(ftype) - da_int = xr.DataArray(frame_int, dims=infodims, coords={'id': idvals, 'vec': infolab_int}) - da_str = xr.DataArray(frame_str, dims=infodims, coords={'id': idvals, 'vec': infolab_str}) - ds_float = da_float.to_dataset(dim="vec") - ds_int = da_int.to_dataset(dim="vec") - ds_str = da_str.to_dataset(dim="vec") - info_ds = xr.combine_by_coords([ds_float, ds_int, ds_str]) + vector_vars = ["rh","vh","Ip","rot"] + scalar_vars = ["name","a","e","inc","capom","omega","capm","Gmass","radius","rhill","J2","J4"] + time_vars = ["rh","vh","Ip","rot","a","e","inc","capom","omega","capm","Gmass","radius","rhill","J2","J4"] + + # Check for valid keyword arguments + kwargs = {k:kwargs[k] for k,v in kwargs.items() if v is not None} + if param['ROTATION']: + if "rot" not in kwargs and "Gmass" in kwargs: + kwargs['rot'] = np.zeros((len(kwargs['Gmass']),3)) + if "Ip" not in kwargs and "Gmass" in kwargs: + kwargs['Ip'] = np.full_like(kwargs['Gmass'], 0.4) + + if "time" not in kwargs: + kwargs["time"] = np.array([0.0]) + + valid_arguments = vector_vars + scalar_vars + ['time','id'] + + kwargs = {k:v for k,v in kwargs.items() if k in valid_arguments} + + data_vars = {k:(scalar_dims,v) for k,v in kwargs.items() if k in scalar_vars} + data_vars.update({k:(vector_dims,v) for k,v in kwargs.items() if k in vector_vars}) + ds = xr.Dataset(data_vars=data_vars, + coords={ + "id":(["id"],kwargs['id']), + "space":(["space"],space_coords), + } + ) + time_vars = [v for v in time_vars if v in ds] + for v in time_vars: + ds[v] = ds[v].expand_dims({"time":1}).assign_coords({"time": kwargs['time']}) - frame_float = np.expand_dims(vec_float.T, axis=0) - frame_str = vec_str.T - da_float = xr.DataArray(frame_float, dims=dims, coords={'time': [t], 'id': idvals, 'vec': label_float}).astype(ftype) - da_str= xr.DataArray(frame_str, dims=infodims, coords={'id': idvals, 'vec': label_str}) - ds_float = da_float.to_dataset(dim="vec") - ds_str = da_str.to_dataset(dim="vec") - ds = xr.combine_by_coords([ds_float, ds_str,info_ds]) return ds \ No newline at end of file diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 4678b4784..ade7cac00 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -17,8 +17,118 @@ import tempfile import re -newfeaturelist = ("FRAGMENTATION", "ROTATION", "TIDES", "ENERGY", "GR", "YARKOVSKY", "YORP", "IN_FORM") -string_varnames = ["name", "particle_type", "status", "origin_type"] +# This defines features that are new in Swiftest and not in Swifter (for conversion between param.in files) +newfeaturelist = ("RESTART", + "FRAGMENTATION", + "ROTATION", + "TIDES", + "ENERGY", + "GR", + "YARKOVSKY", + "YORP", + "IN_FORM", + "SEED", + "INTERACTION_LOOPS", + "ENCOUNTER_CHECK", + "TSTART", + "DUMP_CADENCE", + "ENCOUNTER_SAVE") + + + +# This list defines features that are booleans, so must be converted to/from string when writing/reading from file +bool_param = ["RESTART", + "CHK_CLOSE", + "EXTRA_FORCE", + "RHILL_PRESENT", + "BIG_DISCARD", + "FRAGMENTATION", + "ROTATION", + "TIDES", + "ENERGY", + "GR", + "YARKOVSKY", + "YORP"] + +int_param = ["ISTEP_OUT", "DUMP_CADENCE"] +float_param = ["T0", "TSTART", "TSTOP", "DT", "CHK_RMIN", "CHK_RMAX", "CHK_EJECT", "CHK_QMIN", "DU2M", "MU2KG", + "TU2S", "MIN_GMFRAG", "GMTINY"] + +upper_str_param = ["OUT_TYPE","OUT_FORM","OUT_STAT","IN_TYPE","IN_FORM","ENCOUNTER_SAVE", "CHK_QMIN_COORD"] +lower_str_param = ["NC_IN", "PL_IN", "TP_IN", "CB_IN", "CHK_QMIN_RANGE"] + +param_keys = ['! VERSION'] + int_param + float_param + upper_str_param + lower_str_param+ bool_param + +# This defines Xarray Dataset variables that are strings, which must be processed due to quirks in how NetCDF-Fortran +# handles strings differently than Python's Xarray. +string_varnames = ["name", "particle_type", "status", "origin_type", "stage", "regime"] +char_varnames = ["space"] +int_varnames = ["id", "ntp", "npl", "nplm", "discard_body_id", "collision_id", "loopnum"] + +def bool2yesno(boolval): + """ + Converts a boolean into a string of either "YES" or "NO". + + Parameters + ---------- + boolval : bool + Input value + + Returns + ------- + {"YES","NO"} + + """ + if boolval: + return "YES" + else: + return "NO" + +def bool2tf(boolval): + """ + Converts a boolean into a string of either "T" or "F". + + Parameters + ---------- + boolval : bool + Input value + + Returns + ------- + {"T","F"} + + """ + if boolval: + return "T" + else: + return "F" + +def str2bool(input_str): + """ + Converts a string into an equivalent boolean. + + Parameters + ---------- + input_str : {"YES", "Y", "T", "TRUE", ".TRUE.", "NO", "N", "F", "FALSE", ".FALSE."} + Input string. Input is case-insensitive. + + Returns + ------- + {True, False} + + """ + if type(input_str) is bool: + return input_str + valid_true = ["YES", "Y", "T", "TRUE", ".TRUE."] + valid_false = ["NO", "N", "F", "FALSE", ".FALSE."] + if input_str.upper() in valid_true: + return True + elif input_str.upper() in valid_false: + return False + else: + raise ValueError(f"{input_str} is not recognized as boolean") + + def real2float(realstr): """ @@ -27,7 +137,7 @@ def real2float(realstr): Parameters ---------- - realstr : string + realstr : str Fortran-generated ASCII string of a real value. Returns @@ -52,8 +162,8 @@ def read_swiftest_param(param_file_name, param, verbose=True): param : dict A dictionary containing the entries in the user parameter file """ - param['! VERSION'] = f"Swiftest parameter input from file {param_file_name}" - + param['! VERSION'] = f"Swiftest parameter input file" + # Read param.in file if verbose: print(f'Reading Swiftest file {param_file_name}') try: @@ -64,52 +174,44 @@ def read_swiftest_param(param_file_name, param, verbose=True): if fields[0][0] != '!': key = fields[0].upper() param[key] = fields[1] - #for key in param: - # if (key == fields[0].upper()): param[key] = fields[1] # Special case of CHK_QMIN_RANGE requires a second input if fields[0].upper() == 'CHK_QMIN_RANGE': alo = real2float(fields[1]) ahi = real2float(fields[2]) param['CHK_QMIN_RANGE'] = f"{alo} {ahi}" - - param['ISTEP_OUT'] = int(param['ISTEP_OUT']) - param['ISTEP_DUMP'] = int(param['ISTEP_DUMP']) - param['OUT_TYPE'] = param['OUT_TYPE'].upper() - param['OUT_FORM'] = param['OUT_FORM'].upper() - param['OUT_STAT'] = param['OUT_STAT'].upper() - param['IN_TYPE'] = param['IN_TYPE'].upper() - param['IN_FORM'] = param['IN_FORM'].upper() - param['T0'] = real2float(param['T0']) - param['TSTOP'] = real2float(param['TSTOP']) - param['DT'] = real2float(param['DT']) - param['CHK_RMIN'] = real2float(param['CHK_RMIN']) - param['CHK_RMAX'] = real2float(param['CHK_RMAX']) - param['CHK_EJECT'] = real2float(param['CHK_EJECT']) - param['CHK_QMIN'] = real2float(param['CHK_QMIN']) - param['DU2M'] = real2float(param['DU2M']) - param['MU2KG'] = real2float(param['MU2KG']) - param['TU2S'] = real2float(param['TU2S']) - param['EXTRA_FORCE'] = param['EXTRA_FORCE'].upper() - param['BIG_DISCARD'] = param['BIG_DISCARD'].upper() - param['CHK_CLOSE'] = param['CHK_CLOSE'].upper() - param['RHILL_PRESENT'] = param['RHILL_PRESENT'].upper() - param['FRAGMENTATION'] = param['FRAGMENTATION'].upper() - if param['FRAGMENTATION'] == 'YES' and param['PARTICLE_OUT'] == '': - if param['OUT_TYPE'] == 'REAL8' or param['OUT_TYPE'] == 'REAL4': - param['PARTICLE_OUT'] = 'particle.dat' - param['ROTATION'] = param['ROTATION'].upper() - param['TIDES'] = param['TIDES'].upper() - param['ENERGY'] = param['ENERGY'].upper() - param['GR'] = param['GR'].upper() - param['INTERACTION_LOOPS'] = param['INTERACTION_LOOPS'].upper() - param['ENCOUNTER_CHECK'] = param['ENCOUNTER_CHECK'].upper() - if 'GMTINY' in param: - param['GMTINY'] = real2float(param['GMTINY']) + + for uc in upper_str_param: + if uc in param: + param[uc] = param[uc].upper() + + for i in int_param: + if i in param and type(param[i]) != int: + param[i] = int(float(param[i])) + + for f in float_param: + if f in param and type(param[f]) is str: + param[f] = real2float(param[f]) + + for b in bool_param: + if b in param: + param[b] = str2bool(param[b]) except IOError: print(f"{param_file_name} not found.") return param +def reorder_dims(ds): + # Re-order dimension coordinates so that they are in the same order as the Fortran side + idx = ds.indexes + if "id" in idx: + dim_order = ["time", "id", "space"] + elif "name" in idx: + dim_order = ["time", "name", "space"] + else: + dim_order = idx + idx = {index_name: idx[index_name] for index_name in dim_order} + ds = ds.reindex(idx) + return ds def read_swifter_param(param_file_name, verbose=True): """ Reads in a Swifter param.in file and saves it as a dictionary @@ -140,7 +242,7 @@ def read_swifter_param(param_file_name, verbose=True): 'OUT_STAT': "NEW", 'J2': "0.0", 'J4': "0.0", - 'CHK_CLOSE': 'NO', + 'CHK_CLOSE': False, 'CHK_RMIN': "-1.0", 'CHK_RMAX': "-1.0", 'CHK_EJECT': "-1.0", @@ -148,9 +250,9 @@ def read_swifter_param(param_file_name, verbose=True): 'CHK_QMIN_COORD': "HELIO", 'CHK_QMIN_RANGE': "", 'ENC_OUT': "", - 'EXTRA_FORCE': 'NO', - 'BIG_DISCARD': 'NO', - 'RHILL_PRESENT': 'NO', + 'EXTRA_FORCE': False, + 'BIG_DISCARD': False, + 'RHILL_PRESENT': False, 'C': "-1.0", } @@ -180,10 +282,9 @@ def read_swifter_param(param_file_name, verbose=True): param['CHK_RMAX'] = real2float(param['CHK_RMAX']) param['CHK_EJECT'] = real2float(param['CHK_EJECT']) param['CHK_QMIN'] = real2float(param['CHK_QMIN']) - param['EXTRA_FORCE'] = param['EXTRA_FORCE'].upper() - param['BIG_DISCARD'] = param['BIG_DISCARD'].upper() - param['CHK_CLOSE'] = param['CHK_CLOSE'].upper() - param['RHILL_PRESENT'] = param['RHILL_PRESENT'].upper() + for b in bool_param: + if b in param: + param[b] = str2bool(param[b]) if param['C'] != '-1.0': param['C'] = real2float(param['C']) else: @@ -216,7 +317,6 @@ def read_swift_param(param_file_name, startfile="swift.in", verbose=True): 'DTOUT': 0.0, 'DTDUMP': 0.0, 'L1': "F", - 'L1': "F", 'L2': "F", 'L3': "F", 'L4': "F", @@ -323,37 +423,22 @@ def write_labeled_param(param, param_file_name): Prints a text file containing the parameter information. """ outfile = open(param_file_name, 'w') - keylist = ['! VERSION', - 'T0', - 'TSTOP', - 'DT', - 'ISTEP_OUT', - 'ISTEP_DUMP', - 'OUT_FORM', - 'OUT_TYPE', - 'OUT_STAT', - 'IN_TYPE', - 'PL_IN', - 'TP_IN', - 'CB_IN', - 'BIN_OUT', - 'CHK_QMIN', - 'CHK_RMIN', - 'CHK_RMAX', - 'CHK_EJECT', - 'CHK_QMIN_COORD', - 'CHK_QMIN_RANGE', - 'MU2KG', - 'TU2S', - 'DU2M' ] ptmp = param.copy() # Print the list of key/value pairs in the preferred order - for key in keylist: + for key in param_keys: val = ptmp.pop(key, None) - if val is not None: print(f"{key:<16} {val}", file=outfile) + if val is not None: + if type(val) is bool: + print(f"{key:<32} {bool2yesno(val)}", file=outfile) + else: + print(f"{key:<32} {val}", file=outfile) # Print the remaining key/value pairs in whatever order for key, val in ptmp.items(): - if val != "": print(f"{key:<16} {val}", file=outfile) + if val != "": + if type(val) is bool: + print(f"{key:<32} {bool2yesno(val)}", file=outfile) + else: + print(f"{key:<32} {val}", file=outfile) outfile.close() return @@ -420,12 +505,8 @@ def swifter_stream(f, param): tlab = [] if param['OUT_FORM'] == 'XV' or param['OUT_FORM'] == 'XVEL': - tlab.append('xhx') - tlab.append('xhy') - tlab.append('xhz') - tlab.append('vhx') - tlab.append('vhy') - tlab.append('vhz') + tlab.append('rh') + tlab.append('vh') if param['OUT_FORM'] == 'EL' or param['OUT_FORM'] == 'XVEL': tlab.append('a') tlab.append('e') @@ -468,12 +549,8 @@ def make_swiftest_labels(param): """ tlab = [] if param['OUT_FORM'] == 'XV' or param['OUT_FORM'] == 'XVEL': - tlab.append('xhx') - tlab.append('xhy') - tlab.append('xhz') - tlab.append('vhx') - tlab.append('vhy') - tlab.append('vhz') + tlab.append('rh') + tlab.append('vh') if param['OUT_FORM'] == 'EL' or param['OUT_FORM'] == 'XVEL': tlab.append('a') @@ -484,25 +561,17 @@ def make_swiftest_labels(param): tlab.append('capm') plab = tlab.copy() plab.append('Gmass') - if param['CHK_CLOSE'] == 'YES': + if param['CHK_CLOSE']: plab.append('radius') - if param['RHILL_PRESENT'] == 'YES': + if param['RHILL_PRESENT']: plab.append('rhill') clab = ['Gmass', 'radius', 'j2rp2', 'j4rp4'] - if param['ROTATION'] == 'YES': - clab.append('Ip1') - clab.append('Ip2') - clab.append('Ip3') - clab.append('rotx') - clab.append('roty') - clab.append('rotz') - plab.append('Ip1') - plab.append('Ip2') - plab.append('Ip3') - plab.append('rotx') - plab.append('roty') - plab.append('rotz') - if param['TIDES'] == 'YES': + if param['ROTATION']: + clab.append('Ip') + clab.append('rot') + plab.append('Ip') + plab.append('rot') + if param['TIDES']: clab.append('k2') clab.append('Q') plab.append('k2') @@ -510,19 +579,11 @@ def make_swiftest_labels(param): infolab_float = [ "origin_time", - "origin_xhx", - "origin_xhy", - "origin_xhz", - "origin_vhx", - "origin_vhy", - "origin_vhz", + "origin_rh", + "origin_vh", "discard_time", - "discard_xhx", - "discard_xhy", - "discard_xhz", - "discard_vhx", - "discard_vhy", - "discard_vhz", + "discard_rh", + "discard_vh", ] infolab_int = [ "collision_id", @@ -589,14 +650,14 @@ def swiftest_stream(f, param): Rcb = f.read_reals(np.float64) J2cb = f.read_reals(np.float64) J4cb = f.read_reals(np.float64) - if param['ROTATION'] == 'YES': + if param['ROTATION']: Ipcbx = f.read_reals(np.float64) Ipcby = f.read_reals(np.float64) Ipcbz = f.read_reals(np.float64) rotcbx = f.read_reals(np.float64) rotcby = f.read_reals(np.float64) rotcbz = f.read_reals(np.float64) - if param['TIDES'] == 'YES': + if param['TIDES']: k2cb = f.read_reals(np.float64) Qcb = f.read_reals(np.float64) if npl[0] > 0: @@ -620,17 +681,17 @@ def swiftest_stream(f, param): p11 = f.read_reals(np.float64) p12 = f.read_reals(np.float64) GMpl = f.read_reals(np.float64) - if param['RHILL_PRESENT'] == 'YES': + if param['RHILL_PRESENT']: rhill = f.read_reals(np.float64) Rpl = f.read_reals(np.float64) - if param['ROTATION'] == 'YES': + if param['ROTATION']: Ipplx = f.read_reals(np.float64) Ipply = f.read_reals(np.float64) Ipplz = f.read_reals(np.float64) rotplx = f.read_reals(np.float64) rotply = f.read_reals(np.float64) rotplz = f.read_reals(np.float64) - if param['TIDES'] == 'YES': + if param['TIDES']: k2pl = f.read_reals(np.float64) Qpl = f.read_reals(np.float64) if ntp[0] > 0: @@ -680,14 +741,14 @@ def swiftest_stream(f, param): tpid = np.empty(0) tpnames = np.empty(0) cvec = np.array([Mcb, Rcb, J2cb, J4cb]) - if param['RHILL_PRESENT'] == 'YES': + if param['RHILL_PRESENT']: if npl > 0: pvec = np.vstack([pvec, rhill]) - if param['ROTATION'] == 'YES': + if param['ROTATION']: cvec = np.vstack([cvec, Ipcbx, Ipcby, Ipcbz, rotcbx, rotcby, rotcbz]) if npl > 0: pvec = np.vstack([pvec, Ipplx, Ipply, Ipplz, rotplx, rotply, rotplz]) - if param['TIDES'] == 'YES': + if param['TIDES']: cvec = np.vstack([cvec, k2cb, Qcb]) if npl > 0: pvec = np.vstack([pvec, k2pl, Qpl]) @@ -709,7 +770,7 @@ def swifter2xr(param, verbose=True): ------- xarray dataset """ - dims = ['time', 'id', 'vec'] + dims = ['time', 'id','vec'] pl = [] tp = [] with FortranFile(param['BIN_OUT'], 'r') as f: @@ -738,6 +799,30 @@ def swifter2xr(param, verbose=True): if verbose: print(f"Successfully converted {ds.sizes['time']} output frames.") return ds +def process_netcdf_input(ds, param): + """ + Performs several tasks to convert raw NetCDF files output by the Fortran program into a form that + is used by the Python side. These include: + - Ensuring all types are correct + - Removing any bad id values (empty id slots) + - Swapping the id and name dimension if the names are unique + + Parameters + ---------- + ds : Xarray dataset + + Returns + ------- + ds : xarray dataset + """ + # + + if param['OUT_TYPE'] == "NETCDF_DOUBLE": + ds = fix_types(ds,ftype=np.float64) + elif param['OUT_TYPE'] == "NETCDF_FLOAT": + ds = fix_types(ds,ftype=np.float32) + + return ds def swiftest2xr(param, verbose=True): """ @@ -752,54 +837,12 @@ def swiftest2xr(param, verbose=True): ------- xarray dataset """ - if ((param['OUT_TYPE'] == 'REAL8') or (param['OUT_TYPE'] == 'REAL4')): - dims = ['time', 'id', 'vec'] - cb = [] - pl = [] - tp = [] - cbn = None - try: - with FortranFile(param['BIN_OUT'], 'r') as f: - for t, cbid, cbnames, cvec, clab, \ - npl, plid, plnames, pvec, plab, \ - ntp, tpid, tpnames, tvec, tlab in swiftest_stream(f, param): - # Prepare frames by adding an extra axis for the time coordinate - cbframe = np.expand_dims(cvec, axis=0) - plframe = np.expand_dims(pvec, axis=0) - tpframe = np.expand_dims(tvec, axis=0) - - - # Create xarray DataArrays out of each body type - cbxr = xr.DataArray(cbframe, dims=dims, coords={'time': t, 'id': cbid, 'vec': clab}) - cbxr = cbxr.assign_coords(name=("id", cbnames)) - plxr = xr.DataArray(plframe, dims=dims, coords={'time': t, 'id': plid, 'vec': plab}) - plxr = plxr.assign_coords(name=("id", plnames)) - tpxr = xr.DataArray(tpframe, dims=dims, coords={'time': t, 'id': tpid, 'vec': tlab}) - tpxr = tpxr.assign_coords(name=("id", tpnames)) - - cb.append(cbxr) - pl.append(plxr) - tp.append(tpxr) - - sys.stdout.write('\r' + f"Reading in time {t[0]:.3e}") - sys.stdout.flush() - except IOError: - print(f"Error encountered reading in {param['BIN_OUT']}") - - cbda = xr.concat(cb, dim='time') - plda = xr.concat(pl, dim='time') - tpda = xr.concat(tp, dim='time') - - cbds = cbda.to_dataset(dim='vec') - plds = plda.to_dataset(dim='vec') - tpds = tpda.to_dataset(dim='vec') - if verbose: print('\nCreating Dataset') - ds = xr.combine_by_coords([cbds, plds, tpds]) - elif ((param['OUT_TYPE'] == 'NETCDF_DOUBLE') or (param['OUT_TYPE'] == 'NETCDF_FLOAT')): + + if ((param['OUT_TYPE'] == 'NETCDF_DOUBLE') or (param['OUT_TYPE'] == 'NETCDF_FLOAT')): if verbose: print('\nCreating Dataset from NetCDF file') ds = xr.open_dataset(param['BIN_OUT'], mask_and_scale=False) - ds = clean_string_values(ds) + ds = process_netcdf_input(ds, param) else: print(f"Error encountered. OUT_TYPE {param['OUT_TYPE']} not recognized.") return None @@ -807,14 +850,14 @@ def swiftest2xr(param, verbose=True): return ds -def xstrip(a): +def xstrip_nonstr(a): """ Cleans up the string values in the DataSet to remove extra white space Parameters ---------- a : xarray dataset - + Returns ------- da : xarray dataset with the strings cleaned up @@ -822,6 +865,22 @@ def xstrip(a): func = lambda x: np.char.strip(x) return xr.apply_ufunc(func, a.str.decode(encoding='utf-8'),dask='parallelized') +def xstrip_str(a): + """ + Cleans up the string values in the DataSet to remove extra white space + + Parameters + ---------- + a : xarray dataset + + Returns + ------- + da : xarray dataset with the strings cleaned up + """ + func = lambda x: np.char.strip(x) + return xr.apply_ufunc(func, a,dask='parallelized') + + def string_converter(da): """ Converts a string to a unicode string @@ -829,15 +888,33 @@ def string_converter(da): Parameters ---------- da : xarray dataset - + + Returns + ------- + da : xarray dataset with the strings cleaned up + """ + + da = da.astype(' 0, drop=True) + cb = frame.isel(name=0) + pl = frame.where(name != cb.name) pl = pl.where(np.invert(np.isnan(pl['Gmass'])), drop=True).drop_vars(['j2rp2', 'j2rp2'],errors="ignore") tp = frame.where(np.isnan(frame['Gmass']), drop=True).drop_vars(['Gmass', 'radius', 'j2rp2', 'j4rp4'],errors="ignore") GMSun = np.double(cb['Gmass']) - if param['CHK_CLOSE'] == 'YES': + if param['CHK_CLOSE']: RSun = np.double(cb['radius']) else: RSun = param['CHK_RMIN'] J2 = np.double(cb['j2rp2']) J4 = np.double(cb['j4rp4']) cbname = cb['name'].values[0] - if param['ROTATION'] == 'YES': - Ip1cb = np.double(cb['Ip1']) - Ip2cb = np.double(cb['Ip2']) - Ip3cb = np.double(cb['Ip3']) - rotxcb = np.double(cb['rotx']) - rotycb = np.double(cb['roty']) - rotzcb = np.double(cb['rotz']) + if param['ROTATION']: + Ip1cb = np.double(cb['Ip'].values[0]) + Ip2cb = np.double(cb['Ip'].values[1]) + Ip3cb = np.double(cb['Ip'].values[2]) + rotxcb = np.double(cb['rot'].values[0]) + rotycb = np.double(cb['rot'].values[1]) + rotzcb = np.double(cb['rot'].values[2]) cbid = int(0) if in_type == 'ASCII': @@ -1043,7 +1164,7 @@ def swiftest_xr2infile(ds, param, in_type="NETCDF_DOUBLE", infile_name=None,fram print(RSun, file=cbfile) print(J2, file=cbfile) print(J4, file=cbfile) - if param['ROTATION'] == 'YES': + if param['ROTATION']: print(Ip1cb, Ip2cb, Ip3cb, file=cbfile) print(rotxcb, rotycb, rotzcb, file=cbfile) cbfile.close() @@ -1052,23 +1173,23 @@ def swiftest_xr2infile(ds, param, in_type="NETCDF_DOUBLE", infile_name=None,fram print(pl.id.count().values, file=plfile) for i in pl.id: pli = pl.sel(id=i) - if param['RHILL_PRESENT'] == 'YES': + if param['RHILL_PRESENT']: print(pli['name'].values[0], pli['Gmass'].values[0], pli['rhill'].values[0], file=plfile) else: print(pli['name'].values[0], pli['Gmass'].values[0], file=plfile) - if param['CHK_CLOSE'] == 'YES': + if param['CHK_CLOSE']: print(pli['radius'].values[0], file=plfile) if param['IN_FORM'] == 'XV': - print(pli['xhx'].values[0], pli['xhy'].values[0], pli['xhz'].values[0], file=plfile) - print(pli['vhx'].values[0], pli['vhy'].values[0], pli['vhz'].values[0], file=plfile) + print(pli['rh'].values[0,0], pli['rh'].values[0,1], pli['rh'].values[0,2], file=plfile) + print(pli['vh'].values[0,0], pli['vh'].values[0,1], pli['vh'].values[0,2], file=plfile) elif param['IN_FORM'] == 'EL': print(pli['a'].values[0], pli['e'].values[0], pli['inc'].values[0], file=plfile) print(pli['capom'].values[0], pli['omega'].values[0], pli['capm'].values[0], file=plfile) else: print(f"{param['IN_FORM']} is not a valid input format type.") - if param['ROTATION'] == 'YES': - print(pli['Ip1'].values[0], pli['Ip2'].values[0], pli['Ip3'].values[0], file=plfile) - print(pli['rotx'].values[0], pli['roty'].values[0], pli['rotz'].values[0], file=plfile) + if param['ROTATION']: + print(pli['Ip'].values[0,0], pli['Ip'].values[0,1], pli['Ip'].values[0,2], file=plfile) + print(pli['rot'].values[0,0], pli['rot'].values[0,1], pli['rot'].values[0,2], file=plfile) plfile.close() # TP file @@ -1078,8 +1199,8 @@ def swiftest_xr2infile(ds, param, in_type="NETCDF_DOUBLE", infile_name=None,fram tpi = tp.sel(id=i) print(tpi['name'].values[0], file=tpfile) if param['IN_FORM'] == 'XV': - print(tpi['xhx'].values[0], tpi['xhy'].values[0], tpi['xhz'].values[0], file=tpfile) - print(tpi['vhx'].values[0], tpi['vhy'].values[0], tpi['vhz'].values[0], file=tpfile) + print(tpi['rh'].values[0,0], tpi['rh'].values[0,1], tpi['rh'].values[0,2], file=tpfile) + print(tpi['vh'].values[0,0], tpi['vh'].values[0,1], tpi['vh'].values[0,2], file=tpfile) elif param['IN_FORM'] == 'EL': print(tpi['a'].values[0], tpi['e'].values[0], tpi['inc'].values[0], file=tpfile) print(tpi['capom'].values[0], tpi['omega'].values[0], tpi['capm'].values[0], file=tpfile) @@ -1107,15 +1228,20 @@ def swifter_xr2infile(ds, param, framenum=-1): ------- A set of input files for a Swifter run """ + frame = ds.isel(time=framenum) + if "name" in frame.dims: + frame = frame.swap_dims({"name" : "id"}) + frame = frame.reset_coords("name") + cb = frame.where(frame.id == 0, drop=True) pl = frame.where(frame.id > 0, drop=True) pl = pl.where(np.invert(np.isnan(pl['Gmass'])), drop=True).drop_vars(['j2rp2', 'j4rp4']) tp = frame.where(np.isnan(frame['Gmass']), drop=True).drop_vars(['Gmass', 'radius', 'j2rp2', 'j4rp4']) GMSun = np.double(cb['Gmass']) - if param['CHK_CLOSE'] == 'YES': + if param['CHK_CLOSE']: RSun = np.double(cb['radius']) else: RSun = param['CHK_RMIN'] @@ -1131,14 +1257,14 @@ def swifter_xr2infile(ds, param, framenum=-1): print('0.0 0.0 0.0', file=plfile) for i in pl.id: pli = pl.sel(id=i) - if param['RHILL_PRESENT'] == "YES": + if param['RHILL_PRESENT']: print(i.values, pli['Gmass'].values, pli['rhill'].values, file=plfile) else: print(i.values, pli['Gmass'].values, file=plfile) - if param['CHK_CLOSE'] == "YES": + if param['CHK_CLOSE']: print(pli['radius'].values, file=plfile) - print(pli['xhx'].values, pli['xhy'].values, pli['xhz'].values, file=plfile) - print(pli['vhx'].values, pli['vhy'].values, pli['vhz'].values, file=plfile) + print(pli['rh'].values[0,0], pli['ry'].values[0,1], pli['rh'].values[0,2], file=plfile) + print(pli['vh'].values[0,0], pli['vh'].values[0,1], pli['vh'].values[0,2], file=plfile) plfile.close() # TP file @@ -1147,8 +1273,8 @@ def swifter_xr2infile(ds, param, framenum=-1): for i in tp.id: tpi = tp.sel(id=i) print(i.values, file=tpfile) - print(tpi['xhx'].values, tpi['xhy'].values, tpi['xhz'].values, file=tpfile) - print(tpi['vhx'].values, tpi['vhy'].values, tpi['vhz'].values, file=tpfile) + print(tpi['rh'].values[0,0], tpi['ry'].values[0,1], tpi['rh'].values[0,2], file=tpfile) + print(tpi['vh'].values[0,0], tpi['vh'].values[0,1], tpi['vh'].values[0,2], file=tpfile) tpfile.close() else: # Now make Swiftest files @@ -1182,10 +1308,10 @@ def swift2swifter(swift_param, plname="", tpname="", conversion_questions={}): intxt = input("Is this a SyMBA input file with RHILL values in pl.in? (y/N)> ") if intxt.upper() == 'Y': isSyMBA = True - swifter_param['RHILL_PRESENT'] = 'YES' + swifter_param['RHILL_PRESENT'] = True else: isSyMBA = False - swifter_param['RHILL_PRESENT'] = 'NO' + swifter_param['RHILL_PRESENT'] = False isDouble = conversion_questions.get('DOUBLE', None) if not isDouble: @@ -1213,9 +1339,9 @@ def swift2swifter(swift_param, plname="", tpname="", conversion_questions={}): swifter_param['OUT_FORM'] = 'XV' if swift_param['LCLOSE'] == "T": - swifter_param['CHK_CLOSE'] = "YES" + swifter_param['CHK_CLOSE'] = True else: - swifter_param['CHK_CLOSE'] = "NO" + swifter_param['CHK_CLOSE'] = False swifter_param['CHK_RMIN'] = swift_param['RMIN'] swifter_param['CHK_RMAX'] = swift_param['RMAX'] @@ -1254,17 +1380,17 @@ def swift2swifter(swift_param, plname="", tpname="", conversion_questions={}): if not intxt: intxt = input("EXTRA_FORCE: Use additional user-specified force routines? (y/N)> ") if intxt.upper() == 'Y': - swifter_param['EXTRA_FORCE'] = 'YES' + swifter_param['EXTRA_FORCE'] = True else: - swifter_param['EXTRA_FORCE'] = 'NO' + swifter_param['EXTRA_FORCE'] = False intxt = conversion_questions.get('BIG_DISCARD', None) if not intxt: intxt = input("BIG_DISCARD: include data for all bodies > GMTINY for each discard record? (y/N)> ") if intxt.upper() == 'Y': - swifter_param['BIG_DISCARD'] = 'YES' + swifter_param['BIG_DISCARD'] = True else: - swifter_param['BIG_DISCARD'] = 'NO' + swifter_param['BIG_DISCARD'] = False # Convert the PL file if plname == '': @@ -1310,18 +1436,18 @@ def swift2swifter(swift_param, plname="", tpname="", conversion_questions={}): else: if swift_param['LCLOSE'] == "T": plrad = real2float(i_list[1]) - if swifter_param['RHILL_PRESENT'] == 'YES': + if swifter_param['RHILL_PRESENT']: print(n + 1, GMpl, rhill, file=plnew) else: print(n + 1, GMpl, file=plnew) - if swifter_param['CHK_CLOSE'] == 'YES': + if swifter_param['CHK_CLOSE']: print(plrad, file=plnew) line = plold.readline() i_list = [i for i in re.split(' +|\t',line) if i.strip()] - xh = real2float(i_list[0]) + rh = real2float(i_list[0]) yh = real2float(i_list[1]) zh = real2float(i_list[2]) - print(xh, yh, zh, file=plnew) + print(rh, yh, zh, file=plnew) line = plold.readline() i_list = [i for i in re.split(' +|\t',line) if i.strip()] vhx = real2float(i_list[0]) @@ -1357,10 +1483,10 @@ def swift2swifter(swift_param, plname="", tpname="", conversion_questions={}): print(npl + n + 1, file=tpnew) line = tpold.readline() i_list = [i for i in re.split(' +|\t',line) if i.strip()] - xh = real2float(i_list[0]) + rh = real2float(i_list[0]) yh = real2float(i_list[1]) zh = real2float(i_list[2]) - print(xh, yh, zh, file=tpnew) + print(rh, yh, zh, file=tpnew) line = tpold.readline() i_list = [i for i in re.split(' +|\t',line) if i.strip()] vhx = real2float(i_list[0]) @@ -1434,22 +1560,22 @@ def swifter2swiftest(swifter_param, plname="", tpname="", cbname="", conversion_ i_list = [i for i in re.split(' +|\t',line) if i.strip()] idnum = int(i_list[0]) GMpl = real2float(i_list[1]) - if swifter_param['RHILL_PRESENT'] == 'YES': + if swifter_param['RHILL_PRESENT']: rhill = real2float(i_list[2]) print(idnum, GMpl, rhill, file=plnew) else: print(idnum, GMpl, file=plnew) - if swifter_param['CHK_CLOSE'] == 'YES': + if swifter_param['CHK_CLOSE']: line = plold.readline() i_list = [i for i in re.split(' +|\t',line) if i.strip()] plrad = real2float(i_list[0]) print(plrad, file=plnew) line = plold.readline() i_list = [i for i in re.split(' +|\t',line) if i.strip()] - xh = real2float(i_list[0]) + rh = real2float(i_list[0]) yh = real2float(i_list[1]) zh = real2float(i_list[2]) - print(xh, yh, zh, file=plnew) + print(rh, yh, zh, file=plnew) line = plold.readline() i_list = [i for i in re.split(' +|\t',line) if i.strip()] vhx = real2float(i_list[0]) @@ -1490,10 +1616,10 @@ def swifter2swiftest(swifter_param, plname="", tpname="", cbname="", conversion_ print(name, file=tpnew) line = tpold.readline() i_list = [i for i in re.split(' +|\t',line) if i.strip()] - xh = real2float(i_list[0]) + rh = real2float(i_list[0]) yh = real2float(i_list[1]) zh = real2float(i_list[2]) - print(xh, yh, zh, file=tpnew) + print(rh, yh, zh, file=tpnew) line = tpold.readline() i_list = [i for i in re.split(' +|\t',line) if i.strip()] vhx = real2float(i_list[0]) @@ -1609,7 +1735,7 @@ def swifter2swiftest(swifter_param, plname="", tpname="", cbname="", conversion_ # Remove the unneeded parameters if 'C' in swiftest_param: - swiftest_param['GR'] = 'YES' + swiftest_param['GR'] = True swiftest_param.pop('C', None) swiftest_param.pop('J2', None) swiftest_param.pop('J4', None) @@ -1698,7 +1824,7 @@ def swiftest2swifter_param(swiftest_param, J2=0.0, J4=0.0): TU2S = swifter_param.pop("TU2S", 1.0) GR = swifter_param.pop("GR", None) if GR is not None: - if GR == 'YES': + if GR: swifter_param['C'] = swiftest.einsteinC * np.longdouble(TU2S) / np.longdouble(DU2M) for key in newfeaturelist: tmp = swifter_param.pop(key, None) @@ -1770,7 +1896,7 @@ def swifter2swift_param(swifter_param, J2=0.0, J4=0.0): swift_param['BINARY_OUTPUTFILE'] = swifter_param['BIN_OUT'] swift_param['STATUS_FLAG_FOR_OPEN_STATEMENTS'] = swifter_param['OUT_STAT'] - if swifter_param['CHK_CLOSE'] == "YES": + if swifter_param['CHK_CLOSE']: swift_param['LCLOSE'] = "T" else: swift_param['LCLOSE'] = "F" diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index d1fa28ede..612aeb4b0 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -8,236 +8,2680 @@ You should have received a copy of the GNU General Public License along with Swiftest. If not, see: https://www.gnu.org/licenses. """ +from __future__ import annotations from swiftest import io from swiftest import init_cond from swiftest import tool from swiftest import constants -from datetime import date +from swiftest import __file__ as _pyfile +import json +import os +from glob import glob +from pathlib import Path +import datetime import xarray as xr import numpy as np -import os +from functools import partial +import numpy.typing as npt import shutil +import subprocess +import shlex +import warnings +from tqdm.auto import tqdm +from typing import ( + Literal, + Dict, + List, + Tuple, + Any +) + + +class Simulation: + """ + This is a class that defines the basic Swift/Swifter/Swiftest simulation object + """ + + def __init__(self,read_param: bool = False, read_old_output: bool = False, simdir: os.PathLike | str = "simdata", **kwargs: Any): + """ + + Parameters + ---------- + read_param : bool, default True + If true, read in a pre-existing parameter input file given by the argument `param_file` if it exists. + Otherwise, create a new parameter file using the arguments passed to Simulation or defaults + + Parameters for a given Simulation object can be set a number of different ways, including via a parameter input + file, arguments to Simulation, the general `set_parameter` method, or the specific setters for groups of + similar parameters (e.g. set_init_cond_files, set_simulation_time, etc.). Each parameter has a default value + that can be overridden by an argument to Simulation(). Some argument parameters have equivalent values that + are passed to the `swiftest_driver` Fortran program via a parameter input file. When declaring a new + Simulation object, parameters are chosen in the following way, from highest to lowest priority" + 1. Arguments to Simulation() + 2. The parameter input file given by `param_file` under the following conditions: + - `read_param` is set to True (default behavior). + - The file given by `param_file` exists. The default file is `param.in` located in the `simdata` directory + inside the current working directory, which can be changed by passing `param_file` as an argument. + - The argument has an equivalent parameter or set of parameters in the parameter input file. + 3. Default values (see below) + read_old_output : bool, default False + If true, read in a pre-existing binary input file given by the argument `output_file_name` if it exists. + Parameter input file equivalent: None + simdir : PathLike, default `"simdir"` + Directory where simulation data will be stored, including the parameter file, initial conditions file, output file, + dump files, and log files. + + **kwargs : See list of valid parameters and their defaults below + + codename : {"Swiftest", "Swifter", "Swift"}, default "Swiftest" + Name of the n-body code that will be used. + Parameter input file equivalent: None + integrator : {"symba","rmvs","whm","helio"}, default "symba" + Name of the n-body integrator that will be used when executing a run. + Parameter input file equivalent: None + read_param : bool, default False + Read the parameter file given by `param_file`. + param_file : str, path-like, or file-lke, default "param.in" + Name of the parameter input file that will be passed to the integrator. + Parameter input file equivalent: None + t0 : float, default 0.0 + The reference time for the start of the simulation. Defaults is 0.0. + Parameter input file equivalent: `T0` + tstart : float, default 0.0 + The start time for a restarted simulation. For a new simulation, tstart will be set to t0 automatically. + Parameter input file equivalent: `TSTART` + tstop : float, optional + The stopping time for a simulation. `tstop` must be greater than `tstart`. + Parameter input file equivalent: `TSTOP` + dt : float, optional + The step size of the simulation. `dt` must be less than or equal to `tstop-tstart`. + Parameter input file equivalent: `DT` + istep_out : int, optional + The number of time steps between output saves to file. *Note*: only `istep_out` or `toutput` can be set. + Parameter input file equivalent: `ISTEP_OUT` + dump_cadence : int, optional + The number of output steps (given by `istep_out`) between when the saved data is dumped to a file. Setting it to 0 + is equivalent to only dumping data to file at the end of the simulation. Default value is 10. + Parameter input file equivalent: `DUMP_CADENCE` + tstep_out : float, optional + The approximate time between when outputs are written to file. Passing this computes + `istep_out = floor(tstep_out/dt)`. *Note*: only `istep_out` or `toutput` can be set. + Parameter input file equivalent: None + init_cond_file_type : {"NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"}, default "NETCDF_DOUBLE" + The file type containing initial conditions for the simulation: + * NETCDF_DOUBLE: A single initial conditions input file in NetCDF file format of type NETCDF_DOUBLE. + * NETCDF_FLOAT: A single initial conditions input file in NetCDF file format of type NETCDF_FLOAT. + * ASCII : Three initial conditions files in ASCII format. The individual files define the central body, + massive body, and test particle initial conditions. + Parameter input file equivalent: `IN_TYPE` + init_cond_file_name : str, path-like, or dict, optional + Name of the input initial condition file or files. Whether to pass a single file name or a dictionary + depends on the argument passed to `init_cond_file_type`: If `init_cond_file_type={"NETCDF_DOUBLE","NETCDF_FLOAT"}`, + then this will be a single file name. If `init_cond_file_type="ASCII"` then this must be a dictionary where: + ```init_cond_file_name = { + "CB" : *path to central body initial conditions file* (Swiftest only), + "PL" : *path to massive body initial conditions file*, + "TP" : *path to test particle initial conditions file* + }``` + If no file name is provided then the following default file names will be used. + * NETCDF_DOUBLE, NETCDF_FLOAT: `init_cond_file_name = "init_cond.nc"` + * ASCII: `init_cond_file_name = {"CB" : "cb.in", "PL" : "pl.in", "TP" : "tp.in"}` + Parameter input file equivalent: `NC_IN`, `CB_IN`, `PL_IN`, `TP_IN` + init_cond_format : {"EL", "XV"}, default "EL" + Indicates whether the input initial conditions are given as orbital elements or cartesian position and + velocity vectors. + > *Note:* If `codename` is "Swift" or "Swifter", EL initial conditions are converted to XV. + Parameter input file equivalent: `IN_FORM` + output_file_type : {"NETCDF_DOUBLE", "NETCDF_FLOAT","REAL4","REAL8","XDR4","XDR8"}, default "NETCDF_DOUBLE" + The file type for the outputs of the simulation. Compatible file types depend on the `codename` argument. + * Swiftest: Only "NETCDF_DOUBLE" or "NETCDF_FLOAT" supported. + * Swifter: Only "REAL4","REAL8","XDR4" or "XDR8" supported. + * Swift: Only "REAL4" supported. + Parameter input file equivalent: `OUT_TYPE` + output_file_name : str or path-like, optional + Name of output file to generate. If not supplied, then one of the default file names are used, depending on + the value passed to `output_file_type`. The default is "data.nc". + Parameter input file equivalent: `BIN_OUT` + output_format : {"XV","XVEL"}, default "XVEL" + Specifies the format for the data saved to the output file. If "XV" then cartesian position and velocity + vectors for all bodies are stored. If "XVEL" then the orbital elements are also stored. + Parameter input file equivalent: `OUT_FORM` + MU : str, default "MSUN" + The mass unit system to use. Case-insensitive valid options are: + * "Msun" : Solar mass + * "Mearth" : Earth mass + * "kg" : kilograms + * "g" : grams + Parameter input file equivalent: None + DU : str, optional + The distance unit system to use. Case-insensitive valid options are: + * "AU" : Astronomical Unit + * "Rearth" : Earth radius + * "m" : meter + * "cm" : centimeter + Parameter input file equivalent: None + TU : str, optional + The time unit system to use. Case-insensitive valid options are: + * "YR" : Year + * "DAY" : Julian day + * "d" : Julian day + * "JD" : Julian day + * "s" : second + Parameter input file equivalent: None + MU2KG: float, optional + The conversion factor to multiply by the mass unit that would convert it to kilogram. + Setting this overrides MU + Parameter input file equivalent: `MU2KG` + DU2M : float, optional + The conversion factor to multiply by the distance unit that would convert it to meter. + Setting this overrides DU + Parameter input file equivalent: `DU2M` + TU2S : float, optional + The conversion factor to multiply by the time unit that would convert it to seconds. + Setting this overrides TU + Parameter input file equivalent: `TU2S` + MU_name : str, optional + The name of the mass unit. When setting one of the standard units via `MU` a name will be + automatically set for the unit, so this argument will override the automatic name. + Parameter input file equivalent: None + DU_name : str, optional + The name of the distance unit. When setting one of the standard units via `DU` a name will be + automatically set for the unit, so this argument will override the automatic name. + Parameter input file equivalent: None + TU_name : str, optional + 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: None + rmin : float, default value is the radius of the Sun in the unit system defined by the unit input arguments. + Minimum distance of the simulation + Parameter input file equivalent: `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. + Maximum distance of the simulation (CHK_RMAX, CHK_QMIN_RANGE[1]) + Parameter input file equivalent: `CHK_RMAX`, `CHK_QMIN_RANGE[1]` + qmin_coord : str, {"HELIO", "BARY"}, default "HELIO" + coordinate frame to use for checking the minimum periapsis distance + Parameter input file equivalent: `QMIN_COORD` + mtiny : float, optional + The minimum mass of fully interacting bodies. Bodies below this mass interact with the larger bodies, + but not each other (SyMBA only). *Note.* Only mtiny or gmtiny is accepted, not both. + Parameter input file equivalent: None + gmtiny : float, optional + The minimum G*mass of fully interacting bodies. Bodies below this mass interact with the larger bodies, + but not each other (SyMBA only). *Note.* Only mtiny or gmtiny is accepted, not both. + Parameter input file equivalent: `GMTINY` + close_encounter_check : bool, default True + Check for close encounters between bodies. If set to True, then the radii of massive bodies must be included + in initial conditions. + Parameter input file equivalent: `CHK_CLOSE` + encounter_save : {"NONE","TRAJECTORY","CLOSEST", "BOTH"}, default "NONE" + Indicate if and how encounter data should be saved. If set to "TRAJECTORY", the position and velocity vectors + of all bodies undergoing close encounters are saved at each intermediate step to the encounter files. + If set to "CLOSEST", the position and velocities at the point of closest approach between pairs of bodies are + computed and stored to the encounter files. If set to "BOTH", then this stores the values that would be computed + in "TRAJECTORY" and "CLOSEST". If set to "NONE" no trajectory information is saved. + *WARNING*: Enabling this feature could lead to very large files. + general_relativity : bool, default True + Include the post-Newtonian correction in acceleration calculations. + Parameter input file equivalent: `GR` + collision_model: {"MERGE","BOUNCE","FRAGGLE"}, default "MERGE" + This is used to set the collision/fragmentation model. [TODO: DESCRIBE THESE] + This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. + Parameter input file equivalent: `COLLISION_MODEL` + minimum_fragment_gmass : float, optional + If fragmentation is turned on, this sets the mimimum G*mass of a collisional fragment that can be generated if a + fragmentation model is enabled. Ignored otherwise. + *Note.* Only set one of minimum_fragment_gmass or minimum_fragment_mass + Parameter input file equivalent: None + minimum_fragment_mass : float, optional + If fragmentation is turned on, this sets the mimimum mass of a collisional fragment that can be generated. if a + fragmentation model is enabled. Ignored otherwise + *Note.* Only set one of minimum_fragment_gmass or minimum_fragment_mass + Parameter input file equivalent: `MIN_GMFRAG` + rotation : bool, default False + If set to True, this turns on rotation tracking and radius, rotation vector, and moments of inertia values + must be included in the initial conditions. + This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. + Parameter input file equivalent: `ROTATION` + compute_conservation_values : bool, default False + Turns on the computation of energy, angular momentum, and mass conservation and reports the values + every output step of a running simulation. + Parameter input file equivalent: `ENERGY` + extra_force: bool, default False + Turns on user-defined force function. + Parameter input file equivalent: `EXTRA_FORCE` + big_discard: bool, default False + Includes big bodies when performing a discard (Swifter only) + Parameter input file equivalent: `BIG_DISCARD` + rhill_present: bool, default False + Include the Hill's radius with the input files . + Parameter input file equivalent: `RHILL_PRESENT` + restart : bool, default False + If true, will restart an old run. The file given by `output_file_name` must exist before the run can + execute. If false, will start a new run. If the file given by `output_file_name` exists, it will be replaced + when the run is executed. + Parameter input file equivalent: `OUT_STAT` + interaction_loops : {"TRIANGULAR","FLAT","ADAPTIVE"}, default "TRIANGULAR" + > *Swiftest Experimental feature* + Specifies which algorithm to use for the computation of body-body gravitational forces. + * "TRIANGULAR" : Upper-triangular double-loops . + * "FLAT" : Body-body interation pairs are flattened into a 1-D array. + * "ADAPTIVE" : Periodically times the TRIANGULAR and FLAT methods and determines which one to use based on + the wall time to complete the loop. *Note:* Using ADAPTIVE means that bit-identical repeatability cannot + be assured, as the choice of algorithm depends on possible external factors that can influence the wall + time calculation. The exact floating-point results of the interaction will be different between the two + algorithm types. + Parameter input file equivalent: `INTERACTION_LOOPS` + encounter_check_loops : {"TRIANGULAR","SORTSWEEP","ADAPTIVE"}, default "TRIANGULAR" + > *Swiftest Experimental feature* + Specifies which algorithm to use for checking whether bodies are in a close encounter state or not. + * "TRIANGULAR" : Upper-triangular double-loops. + * "SORTSWEEP" : A Sort-Sweep algorithm is used to reduce the population of potential close encounter bodies. + This algorithm is still in development, and does not necessarily speed up the encounter checking. + Use with caution. + * "ADAPTIVE" : Periodically times the TRIANGULAR and SORTSWEEP methods and determines which one to use based + on the wall time to complete the loop. *Note:* Using ADAPTIVE means that bit-identical repeatability cannot + be assured, as the choice of algorithm depends on possible external factors that can influence the wall + time calculation. The exact floating-point results of the interaction will be different between the two + algorithm types. + Parameter input file equivalent: `ENCOUNTER_CHECK` + verbose : bool, default True + If set to True, then more information is printed by Simulation methods as they are executed. Setting to + False suppresses most messages other than errors. + Parameter input file equivalent: None + """ + + # Configuration parameters will be stored in a json file alongside the Python source scripts. + self._config_file = Path(_pyfile).parent / "swiftest_configuration.json" + config_exists = self._config_file.exists() + if config_exists: + try: + with open(self._config_file, 'r') as f: + self._swiftest_configuration = json.load(f) + except: + config_exists = False + if not config_exists: + self._swiftest_configuration = {"shell" : str(Path(os.environ['SHELL']).name), + "shell_full" : str(Path(os.environ['SHELL'])), + "getter_column_width" : '32'} + self._swiftest_configuration['startup_script'] = str(Path.home() / f".{str(self._swiftest_configuration['shell'])}rc") + config_json = json.dumps(self._swiftest_configuration, indent=4) + with open(self._config_file, 'w') as f: + f.write(config_json) + + self._getter_column_width = self._swiftest_configuration['getter_column_width'] + self._shell = Path(self._swiftest_configuration['shell']) + self._shell_full = Path(self._swiftest_configuration['shell_full']) + + self.param = {} + self.data = xr.Dataset() + self.init_cond = xr.Dataset() + self.encounters = xr.Dataset() + self.collisions = xr.Dataset() + + self.simdir = Path(simdir) + if self.simdir.exists(): + if not self.simdir.is_dir(): + msg = f"Cannot create the {self.simdir.resolve()} directory: File exists." + msg += "\nDelete the file or change the location of param_file" + raise NotADirectoryError(msg) + else: + if read_old_output or read_param: + raise NotADirectoryError(f"Cannot find directory {self.simdir.resolve()} ") + + # Set the location of the parameter input file, choosing the default if it isn't specified. + param_file = kwargs.pop("param_file",Path.cwd() / self.simdir / "param.in") + self.verbose = kwargs.pop("verbose",True) + + # Parameters are set in reverse priority order. First the defaults, then values from a pre-existing input file, + # then using the arguments passed via **kwargs. + + #-------------------------- + # Lowest Priority: Defaults: + #-------------------------- + # Quietly set all parameters to their defaults. + self.set_parameter(verbose=False,param_file=param_file) + + #----------------------------------------------------------------- + # Higher Priority: Values from a file (if requested and it exists) + #----------------------------------------------------------------- + + # If the user asks to read in an old parameter file or output file, override any default parameters with values from the file + # If the file doesn't exist, flag it for now so we know to create it + param_file_found = False + if read_param or read_old_output: + if self.read_param(read_init_cond = not read_old_output): + # We will add the parameter file to the kwarg list. This will keep the set_parameter method from + # overriding everything with defaults when there are no arguments passed to Simulation() + kwargs['param_file'] = self.param_file + param_file_found = True + else: + param_file_found = False + + # ----------------------------------------------------------------- + # Highest Priority: Values from arguments passed to Simulation() + # ----------------------------------------------------------------- + if len(kwargs) > 0 and "param_file" not in kwargs or len(kwargs) > 1 and "param_file" in kwargs: + self.set_parameter(verbose=False, **kwargs) + + # Let the user know that there was a problem reading an old parameter file and we're going to create a new one + if read_param and not param_file_found: + warnings.warn(f"{self.param_file} not found. Creating a new file using default values for parameters not passed to Simulation().",stacklevel=2) + self.write_param() + + # Read in an old simulation file if requested + if read_old_output: + binpath = os.path.join(self.simdir, self.param['BIN_OUT']) + if os.path.exists(binpath): + self.read_output_file() + else: + raise FileNotFoundError(f"BIN_OUT file {binpath} not found.") + return + + def _run_swiftest_driver(self): + """ + Internal callable function that executes the swiftest_driver run + """ + + # Get current environment variables + + env = os.environ.copy() + driver_script = os.path.join(self.binary_path, "swiftest_driver.sh") + with open(driver_script, 'w') as f: + f.write(f"#{self._shell_full} -l\n") + f.write(f"source ~/.{self._shell}rc\n") + f.write(f"cd {self.simdir}\n") + f.write(f"{str(self.driver_executable)} {self.integrator} {str(self.param_file)} compact\n") + + cmd = f"{env['SHELL']} -l {driver_script}" + + def _type_scrub(output_data): + int_vars = ["ILOOP","NPL","NTP","NPLM"] + for k,v in output_data.items(): + if k in int_vars: + output_data[k] = int(v) + else: + output_data[k] = float(v) + return output_data + + process_output = False + noutput = int((self.param['TSTOP'] - self.param['T0']) / self.param['DT']) + iloop = int((self.param['TSTART'] - self.param['T0']) / self.param['DT']) + twidth = int(np.ceil(np.log10(self.param['TSTOP']/(self.param['DT'] * self.param['ISTEP_OUT'])))) + pre_message = f"Time: {self.param['TSTART']:.{twidth}e} / {self.param['TSTOP']:.{twidth}e} {self.TU_name} " + post_message = f"npl: {self.data['npl'].values[0]} ntp: {self.data['ntp'].values[0]}" + if "nplm" in self.data: + post_message += f" nplm: {self.data['nplm'].values[0]}" + if self.param['ENERGY']: + post_message += f" dL/L0: {0.0:.5e} dE/|E0|: {0.0:+.5e}" + post_message += f" Wall time / step: {0.0:.5e} s" + pbar = tqdm(total=noutput, desc=pre_message, postfix=post_message, bar_format='{l_bar}{bar}{postfix}') + try: + with subprocess.Popen(shlex.split(cmd), + stdout=subprocess.PIPE, + stderr=subprocess.PIPE, + env=env, + universal_newlines=True) as p: + + for line in p.stdout: + if "SWIFTEST STOP" in line: + process_output = False + + if process_output: + kvstream=line.replace('\n','').strip().split(';') # Removes the newline character, + output_data = _type_scrub({kv.split()[0]: kv.split()[1] for kv in kvstream[:-1]}) + pre_message = f"Time: {output_data['T']:.{twidth}e} / {self.param['TSTOP']:.{twidth}e} {self.TU_name}" + post_message = f" npl: {output_data['NPL']} ntp: {output_data['NTP']}" + if "NPLM" in output_data: + post_message += f" nplm: {output_data['NPLM']}" + if "LTOTERR" in output_data: + post_message += f" dL/L0: {output_data['LTOTERR']:.5e}" + if "ETOTERR" in output_data: + post_message += f" dE/|E0|: {output_data['ETOTERR']:+.5e}" + post_message += f" Wall time / step: {output_data['WTPS']:.5e} s" + interval = output_data['ILOOP'] - iloop + if interval > 0: + pbar.update(interval) + pbar.set_description_str(pre_message) + pbar.set_postfix_str(post_message) + iloop = output_data['ILOOP'] + + if "SWIFTEST START" in line: + process_output = True + + res = p.communicate() + if p.returncode != 0: + for line in res[1]: + print(line, end='') + warnings.warn("Failure in swiftest_driver", stacklevel=2) + except: + warnings.warn(f"Error executing main swiftest_driver program", stacklevel=2) + + pbar.close() + return + + def run(self,**kwargs): + """ + Runs a Swiftest integration. Uses the parameters set by the `param` dictionary unless overridden by keyword + arguments. Accepts any keyword arguments that can be passed to `set_parameter`. + + Parameters + ---------- + **kwargs : Any valid keyword arguments accepted by `set_parameter` + + Returns + ------- + None + + """ + + if len(kwargs) > 0: + self.set_parameter(**kwargs) + + # Write out the current parameter set before executing run + self.write_param() + + if self.codename != "Swiftest": + warnings.warn(f"Running an integration is not yet supported for {self.codename}",stacklevel=2) + return + + if self.driver_executable is None: + msg = "Path to swiftest_driver has not been set!" + msg += f"\nMake sure swiftest_driver is compiled and the executable is in {str(self.binary_path)}" + warnings.warn(msg,stacklevel=2) + return + + if not self.restart: + self.clean() + + print(f"Running a {self.codename} {self.integrator} run from tstart={self.param['TSTART']} {self.TU_name} to tstop={self.param['TSTOP']} {self.TU_name}") + + self._run_swiftest_driver() + + # Read in new data + self.read_output_file() + + return + + def _get_valid_arg_list(self, arg_list: str | List[str] | None = None, valid_var: Dict | None = None): + """ + Internal function for getters that extracts subset of arguments that is contained in the dictionary of valid + argument/parameter variable pairs. + + Parameters + ---------- + arg_list : str | List[str], optional + A single string or list of strings containing the Simulation argument. If none are supplied, + then it will create the arg_list out of all keys in the valid_var dictionary. + valid_var : valid_var: Dict + A dictionary where the key is the argument name and the value is the equivalent key in the Simulation + parameter dictionary (i.e. the left-hand column of a param.in file) + + Returns + ------- + valid_arg : [str] + The list of valid arguments that match the keys in valid_var + param : dict + A dictionary that is the subset of the Simulation parameter dictionary corresponding to the arguments listed + in arg_list. + + """ + + if arg_list is None: + valid_arg = None + else: + valid_arg = arg_list.copy() + + if valid_arg is None: + valid_arg = list(valid_var.keys()) + elif type(arg_list) is str: + valid_arg = [arg_list] + else: + # Only allow arg_lists to be checked if they are valid. Otherwise ignore. + valid_arg = [k for k in arg_list if k in list(valid_var.keys())] + + # Extract the arg_list dictionary + param = {valid_var[arg]: self.param[valid_var[arg]] for arg in valid_arg if valid_var[arg] in self.param} + + return valid_arg, param + + def set_simulation_time(self, + t0: float | None = None, + tstart: float | None = None, + tstop: float | None = None, + dt: float | None = None, + istep_out: int | None = None, + tstep_out: float | None = None, + dump_cadence: int | None = None, + verbose: bool | None = None, + **kwargs: Any + ): + """ + + Parameters + ---------- + t0 : float, optional + The reference time for the start of the simulation. Defaults is 0.0 + tstart : float, optional + The start time for a restarted simulation. For a new simulation, tstart will be set to t0 automatically. + tstop : float, optional + The stopping time for a simulation. `tstop` must be greater than `tstart`. + dt : float, optional + The step size of the simulation. `dt` must be less than or equal to `tstop-dstart`. + istep_out : int, optional + The number of time steps between outputs to file. *Note*: only `istep_out` or `toutput` can be set. + tstep_out : float, optional + The approximate time between when outputs are written to file. Passing this computes + `istep_out = floor(tstep_out/dt)`. *Note*: only `istep_out` or `toutput` can be set. + dump_cadence : int, optional + The number of output steps (given by `istep_out`) between when the saved data is dumped to a file. Setting it to 0 + is equivalent to only dumping data to file at the end of the simulation. Default value is 10. + Parameter input file equivalent: `DUMP_CADENCE` + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + set_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. + + Returns + ------- + time_dict : dict + A dictionary containing the requested parameters + + """ + if t0 is None and tstart is None and tstop is None and dt is None and istep_out is None and \ + tstep_out is None and dump_cadence is None: + return {} + + update_list = [] + + if t0 is None: + t0 = self.param.pop("T0", None) + if t0 is None: + t0 = 0.0 + else: + update_list.append("t0") + + if tstart is None: + tstart = self.param.pop("TSTART", None) + if tstart is None: + tstart = t0 + else: + update_list.append("tstart") + + self.param['T0'] = t0 + self.param['TSTART'] = tstart + + if tstop is None: + tstop = self.param.pop("TSTOP", None) + else: + update_list.append("tstop") + + if tstop is not None: + if tstop <= tstart: + warnings.warn("tstop must be greater than tstart.",stacklevel=2) + return {} + + if tstop is not None: + self.param['TSTOP'] = tstop + + if dt is None: + dt = self.param.pop("DT", None) + else: + update_list.append("dt") + + if dt is not None and tstop is not None: + if dt > (tstop - tstart): + msg = "dt must be smaller than tstop-tstart" + msg +=f"\nSetting dt = {tstop - tstart} instead of {dt}" + warnings.warn(msg,stacklevel=2) + dt = tstop - tstart + + if dt is not None: + self.param['DT'] = dt + + if istep_out is None and tstep_out is None: + istep_out = self.param.pop("ISTEP_OUT", None) + elif istep_out is not None and tstep_out is not None: + warnings.warn("istep_out and tstep_out cannot both be set",stacklevel=2) + return {} + else: + update_list.append("istep_out") + + if tstep_out is not None and dt is not None: + istep_out = int(np.floor(tstep_out / dt)) + + if istep_out is not None: + self.param['ISTEP_OUT'] = istep_out + + if dump_cadence is None: + dump_cadence = self.param.pop("DUMP_CADENCE", 1) + else: + update_list.append("dump_cadence") + self.param['DUMP_CADENCE'] = dump_cadence + + time_dict = self.get_simulation_time(update_list, verbose=verbose) + + return time_dict + + def get_simulation_time(self, arg_list: str | List[str] | None = None, verbose: bool | None = None, **kwargs): + """ + + Returns a subset of the parameter dictionary containing the current simulation time parameters. + If the verbose option is set in the Simulation object, then it will also print the values. + + Parameters + ---------- + arg_list : str | List[str], optional + A single string or list of strings containing the names of the simulation time parameters to extract. + Default is all of: + ["t0", "tstart", "tstop", "dt", "istep_out", "tstep_out", "dump_cadence"] + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + get_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. + + + Returns + ------- + time_dict : dict + A dictionary containing the requested parameters + + """ + + valid_var = {"t0": "T0", + "tstart": "TSTART", + "tstop": "TSTOP", + "dt": "DT", + "istep_out": "ISTEP_OUT", + "dump_cadence": "DUMP_CADENCE", + } + + units = {"t0": self.TU_name, + "tstart": self.TU_name, + "tstop": self.TU_name, + "dt": self.TU_name, + "tstep_out": self.TU_name, + "istep_out": "", + "dump_cadence": ""} + + tstep_out = None + if arg_list is None or "tstep_out" in arg_list or "istep_out" in arg_list: + if "ISTEP_OUT" in self.param and "DT" in self.param: + istep_out = self.param['ISTEP_OUT'] + dt = self.param['DT'] + tstep_out = istep_out * dt + + valid_arg, time_dict = self._get_valid_arg_list(arg_list, valid_var) + + if verbose is None: + verbose = self.verbose + + if verbose: + for arg in valid_arg: + key = valid_var[arg] + if key in time_dict: + print(f"{arg:<{self._getter_column_width}} {time_dict[key]} {units[arg]}") + else: + print(f"{arg:<{self._getter_column_width}} NOT SET") + if tstep_out is not None: + print(f"{'tstep_out':<{self._getter_column_width}} {tstep_out} {units['tstep_out']}") + + return time_dict + + def set_parameter(self, verbose: bool = True, **kwargs): + """ + Setter for all possible parameters. This will call each of the specialized setters using keyword arguments. + If no arguments are passed, then default values will be used. + Parameters + ---------- + **kwargs : Any argument listed listed in the Simulation class definition. + + Returns + ------- + param : A dictionary of all Simulation parameters that changed + + """ + + default_arguments = { + "codename" : "Swiftest", + "integrator": "symba", + "t0": 0.0, + "tstart": 0.0, + "tstop": None, + "dt": None, + "istep_out": 1, + "tstep_out": None, + "dump_cadence": 10, + "init_cond_file_type": "NETCDF_DOUBLE", + "init_cond_file_name": None, + "init_cond_format": "EL", + "read_old_output": False, + "output_file_type": "NETCDF_DOUBLE", + "output_file_name": None, + "output_format": "XVEL", + "MU": "MSUN", + "DU": "AU", + "TU": "Y", + "MU2KG": None, + "DU2M": None, + "TU2S": None, + "MU_name": None, + "DU_name": None, + "TU_name": None, + "rmin": constants.RSun / constants.AU2M, + "rmax": 10000.0, + "qmin_coord": "HELIO", + "gmtiny": 0.0, + "mtiny": None, + "close_encounter_check": True, + "general_relativity": True, + "collision_model": "MERGE", + "minimum_fragment_mass": None, + "minimum_fragment_gmass": 0.0, + "rotation": False, + "compute_conservation_values": False, + "extra_force": False, + "big_discard": False, + "rhill_present": False, + "interaction_loops": "TRIANGULAR", + "encounter_check_loops": "TRIANGULAR", + "ephemeris_date": "MBCL", + "restart": False, + "encounter_save" : "NONE" + } + param_file = kwargs.pop("param_file",None) + + # Extract the simulation directory and create it if it doesn't exist + if param_file is not None: + self.param_file = Path.cwd() / param_file + + # If no arguments (other than, possibly, verbose) are requested, use defaults + if len(kwargs) == 0: + kwargs = default_arguments + + unrecognized = [k for k,v in kwargs.items() if k not in default_arguments] + if len(unrecognized) > 0: + for k in unrecognized: + warnings.warn(f'Unrecognized argument "{k}"',stacklevel=2) + + # Add the verbose flag to the kwargs for passing down to the individual setters + kwargs["verbose"] = verbose + + # Setters returning parameter dictionary values + param_dict = {} + 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)) + param_dict.update(self.set_distance_range(**kwargs)) + param_dict.update(self.set_feature(**kwargs)) + + # Non-returning setters + self.set_ephemeris_date(**kwargs) + + return param_dict + + def get_parameter(self, **kwargs): + """ + Setter for all possible parameters. Calls each of the specialized setters using keyword arguments + Parameters + ---------- + **kwargs : Any of the arguments defined in Simulation. If none provided, it returns all arguments. + + Returns + ------- + param : A dictionary of all Simulation parameters requested + + """ + + # Getters returning parameter dictionary values + param_dict = {} + 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) + + return param_dict + + def set_integrator(self, + codename: Literal["Swiftest", "Swifter", "Swift"] | None = None, + integrator: Literal["symba","rmvs","whm","helio"] | None = None, + mtiny: float | None = None, + gmtiny: float | None = None, + verbose: bool | None = None, + **kwargs: Any + ): + """ + + Parameters + ---------- + codename : {"swiftest", "swifter", "swift"}, optional + integrator : {"symba","rmvs","whm","helio"}, optional + Name of the n-body integrator that will be used when executing a run. + mtiny : float, optional + The minimum mass of fully interacting bodies. Bodies below this mass interact with the larger bodies, + but not each other (SyMBA only). *Note.* Only mtiny or gmtiny is accepted, not both. + gmtiny : float, optional + The minimum G*mass of fully interacting bodies. Bodies below this mass interact with the larger bodies, + but not each other (SyMBA only). *Note.* Only mtiny or gmtiny is accepted, not both. + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + set_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. + + Returns + ------- + integrator_dict: dict + A dictionary containing the subset of the parameter dictonary that was updated by this setter + + """ + # TODO: Improve how it finds the executable binary + + update_list = [] + + if codename is not None: + valid_codename = ["Swiftest", "Swifter", "Swift"] + if codename.title() not in valid_codename: + warnings.warn(f"{codename} is not a valid codename. Valid options are ",",".join(valid_codename),stacklevel=2) + try: + self.codename + except: + self.codename = valid_codename[0] + else: + self.codename = codename.title() + + self.param['! VERSION'] = f"{self.codename} input file" + update_list.append("codename") + if self.codename == "Swiftest": + self.binary_path = Path(_pyfile).parent.parent.parent.parent / "bin" + self.driver_executable = self.binary_path / "swiftest_driver" + if not self.driver_executable.exists(): + warnings.warn(f"Cannot find the Swiftest driver in {str(self.binary_path)}",stacklevel=2) + self.driver_executable = None + else: + self.binary_path = "NOT IMPLEMENTED FOR THIS CODE" + self.driver_executable = None + update_list.append("driver_executable") + + if integrator is not None: + valid_integrator = ["symba","rmvs","whm","helio"] + if integrator.lower() not in valid_integrator: + warnings.warn(f"{integrator} is not a valid integrator. Valid options are ",",".join(valid_integrator),stacklevel=2) + try: + self.integrator + except: + self.integrator = valid_integrator[0] + else: + self.integrator = integrator.lower() + update_list.append("integrator") + + if mtiny is not None or gmtiny is not None: + if self.integrator != "symba": + warnings.warn("mtiny and gmtiny are only used by SyMBA.",stacklevel=2) + if mtiny is not None and gmtiny is not None: + warnings.warn("Only set mtiny or gmtiny, not both.",stacklevel=2) + elif gmtiny is not None: + self.param['GMTINY'] = gmtiny + update_list.append("gmtiny") + elif mtiny is not None: + self.param['GMTINY'] = self.GU * mtiny + update_list.append("gmtiny") + + integrator_dict = self.get_integrator(update_list, verbose) + + return integrator_dict + + def get_integrator(self,arg_list: str | List[str] | None = None, verbose: bool | None = None, **kwargs: Any): + """ + + Returns a subset of the parameter dictionary containing the current values of the distance range parameters. + If the verbose option is set in the Simulation object, then it will also print the values. + + Parameters + ---------- + arg_list: str | List[str], optional + A single string or list of strings containing the names of the features to extract. Default is all of: + ["integrator"] + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + get_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. + + Returns + ------- + integrator_dict : dict + The subset of the dictionary containing the code name if codename is selected + """ + + valid_var = {"gmtiny" : "GMTINY"} + + valid_instance_vars = {"codename": self.codename, + "integrator": self.integrator, + "param_file": str(self.param_file), + "driver_executable": str(self.driver_executable)} + + try: + self.integrator + except: + warnings.warn(f"integrator is not set",stacklevel=2) + return {} + + try: + self.codename + except: + warnings.warn(f"codename is not set",stacklevel=2) + return {} + + if verbose is None: + verbose = self.verbose + + if not bool(kwargs) and arg_list is None: + arg_list = list(valid_instance_vars.keys()) + arg_list.append(*[a for a in valid_var.keys() if a not in valid_instance_vars]) + + valid_arg, integrator_dict = self._get_valid_arg_list(arg_list, valid_var) + + if verbose: + for arg in arg_list: + if arg in valid_instance_vars: + print(f"{arg:<{self._getter_column_width}} {valid_instance_vars[arg]}") + for arg in valid_arg: + key = valid_var[arg] + if key in integrator_dict: + if arg == "gmtiny": + if self.integrator == "symba": + print(f"{arg:<{self._getter_column_width}} {integrator_dict[key]} {self.DU_name}^3 / {self.TU_name}^2 ") + print(f"{'mtiny':<{self._getter_column_width}} {integrator_dict[key] / self.GU} {self.MU_name}") + else: + print(f"{arg:<{self._getter_column_width}} {integrator_dict[key]}") + else: + print(f"{arg:<{self._getter_column_width}} NOT SET") + + + return integrator_dict + + def set_feature(self, + close_encounter_check: bool | None = None, + general_relativity: bool | None = None, + collision_model: Literal["MERGE","BOUNCE","FRAGGLE"] | None = None, + minimum_fragment_gmass: float | None = None, + minimum_fragment_mass: float | None = None, + rotation: bool | None = None, + compute_conservation_values: bool | None = None, + extra_force: bool | None = None, + big_discard: bool | None = None, + rhill_present: bool | None = None, + restart: bool | None = None, + tides: bool | None = None, + interaction_loops: Literal["TRIANGULAR", "FLAT", "ADAPTIVE"] | None = None, + encounter_check_loops: Literal["TRIANGULAR", "SORTSWEEP", "ADAPTIVE"] | None = None, + encounter_save: Literal["NONE", "TRAJECTORY", "CLOSEST", "BOTH"] | None = None, + verbose: bool | None = None, + **kwargs: Any + ): + """ + Turns on or off various features of a simulation. + + Parameters + ---------- + close_encounter_check : bool, optional + Check for close encounters between bodies. If set to True, then the radii of massive bodies must be included + in initial conditions. + encounter_save : {"NONE","TRAJECTORY","CLOSEST","BOTH"}, default "NONE" + Indicate if and how encounter data should be saved. If set to "TRAJECTORY", the position and velocity vectors + of all bodies undergoing close encounters are saved at each intermediate step to the encounter files. + If set to "CLOSEST", the position and velocities at the point of closest approach between pairs of bodies are + computed and stored to the encounter files. If set to "BOTH", then this stores the values that would be computed + in "TRAJECTORY" and "CLOSEST". If set to "NONE" no trajectory information is saved. + *WARNING*: Enabling this feature could lead to very large files. + general_relativity : bool, optional + Include the post-Newtonian correction in acceleration calculations. + collision_model: {"MERGE","BOUNCE","FRAGGLE"}, default "MERGE" + This is used to set the collision/fragmentation model. [TODO: DESCRIBE THESE] + This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. + Parameter input file equivalent: `COLLISION_MODEL` + minimum_fragment_gmass : float, optional + If fragmentation is turned on, this sets the mimimum G*mass of a collisional fragment that can be generated if a + fragmentation model is enabled. Ignored otherwise. + *Note.* Only set one of minimum_fragment_gmass or minimum_fragment_mass + Parameter input file equivalent: None + minimum_fragment_mass : float, optional + If fragmentation is turned on, this sets the mimimum mass of a collisional fragment that can be generated. if a + fragmentation model is enabled. Ignored otherwise + *Note.* Only set one of minimum_fragment_gmass or minimum_fragment_mass + Parameter input file equivalent: `MIN_GMFRAG` + rotation : bool, optional + If set to True, this turns on rotation tracking and radius, rotation vector, and moments of inertia values + must be included in the initial conditions. + This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. + compute_conservation_values : bool, optional + Turns on the computation of energy, angular momentum, and mass conservation and reports the values + every output step of a running simulation. + extra_force: bool, optional + Turns on user-defined force function. + big_discard: bool, optional + Includes big bodies when performing a discard (Swifter only) + rhill_present: bool, optional + Include the Hill's radius with the input files. + interaction_loops : {"TRIANGULAR","FLAT","ADAPTIVE"}, default "TRIANGULAR" + *Swiftest Experimental feature* + Specifies which algorithm to use for the computation of body-body gravitational forces. + * "TRIANGULAR" : Upper-triangular double-loops . + * "FLAT" : Body-body interation pairs are flattened into a 1-D array. + * "ADAPTIVE" : Periodically times the TRIANGULAR and FLAT methods and determines which one to use based on + the wall time to complete the loop. *Note:* Using ADAPTIVE means that bit-identical repeatability cannot + be assured, as the choice of algorithm depends on possible external factors that can influence the wall + time calculation. The exact floating-point results of the interaction will be different between the two + algorithm types. + encounter_check_loops : {"TRIANGULAR","SORTSWEEP","ADAPTIVE"}, default "TRIANGULAR" + *Swiftest Experimental feature* + Specifies which algorithm to use for checking whether bodies are in a close encounter state or not. + * "TRIANGULAR" : Upper-triangular double-loops. + * "SORTSWEEP" : A Sort-Sweep algorithm is used to reduce the population of potential close encounter bodies. + This algorithm is still in development, and does not necessarily speed up the encounter checking. + Use with caution. + * "ADAPTIVE" : Periodically times the TRIANGULAR and SORTSWEEP methods and determines which one to use based + on the wall time to complete the loop. *Note:* Using ADAPTIVE means that bit-identical repeatability cannot + be assured, as the choice of algorithm depends on possible external factors that can influence the wall + time calculation. The exact floating-point results of the interaction will be different between the two + algorithm types. + tides: bool, optional + Turns on tidal model (IN DEVELOPMENT - IGNORED) + Yarkovsky: bool, optional + Turns on Yarkovsky model (IN DEVELOPMENT - IGNORED) + YORP: bool, optional + Turns on YORP model (IN DEVELOPMENT - IGNORED) + restart : bool, default False + If true, will restart an old run. The file given by `output_file_name` must exist before the run can + execute. If false, will start a new run. If the file given by `output_file_name` exists, it will be replaced + when the run is executed. + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + set_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. + + Returns + ------- + feature_dict : dict + A dictionary containing the requested features. + + """ + + update_list = [] + if close_encounter_check is not None: + self.param["CHK_CLOSE"] = close_encounter_check + update_list.append("close_encounter_check") + + if general_relativity is not None: + self.param["GR"] = general_relativity + update_list.append("general_relativity") + + fragmentation_models = ["FRAGGLE"] + if collision_model is not None: + collision_model = collision_model.upper() + fragmentation = collision_model in fragmentation_models + if self.codename != "Swiftest" and self.integrator != "symba" and fragmentation: + warnings.warn("Fragmentation is only available on Swiftest SyMBA.",stacklevel=2) + self.param['COLLISION_MODEL'] = "MERGE" + else: + self.param['COLLISION_MODEL'] = collision_model + update_list.append("collision_model") + if fragmentation: + if "MIN_GMFRAG" not in self.param and minimum_fragment_mass is None and minimum_fragment_gmass is None: + warnings.warn("Minimum fragment mass is not set. Set it using minimum_fragment_gmass or minimum_fragment_mass",stacklevel=2) + else: + update_list.append("minimum_fragment_gmass") + + if minimum_fragment_gmass is not None and minimum_fragment_mass is not None: + warnings.warn("Only set either minimum_fragment_mass or minimum_fragment_gmass, but not both!",stacklevel=2) + + if minimum_fragment_gmass is not None: + self.param["MIN_GMFRAG"] = minimum_fragment_gmass + if "minmum_fragment_gmass" not in update_list: + update_list.append("minimum_fragment_gmass") + elif minimum_fragment_mass is not None: + self.param["MIN_GMFRAG"] = minimum_fragment_mass * self.GU + if "minimum_fragment_gmass" not in update_list: + update_list.append("minimum_fragment_gmass") + + if rotation is not None: + self.param['ROTATION'] = rotation + update_list.append("rotation") + + if self.param['COLLISION_MODEL'] == "FRAGGLE" and not self.param['ROTATION']: + self.param['ROTATION'] = True + update_list.append("rotation") + + if compute_conservation_values is not None: + self.param["ENERGY"] = compute_conservation_values + update_list.append("compute_conservation_values") + + if extra_force is not None: + self.param["EXTRA_FORCE"] = extra_force + update_list.append("extra_force") + + if big_discard is not None: + if self.codename != "Swifter": + self.param["BIG_DISCARD"] = False + else: + self.param["BIG_DISCARD"] = big_discard + update_list.append("big_discard") + + if rhill_present is not None: + self.param["RHILL_PRESENT"] = rhill_present + update_list.append("rhill_present") + + if restart is not None: + self.param["RESTART"] = restart + update_list.append("restart") + + if interaction_loops is not None: + valid_vals = ["TRIANGULAR", "FLAT", "ADAPTIVE"] + if interaction_loops not in valid_vals: + msg = f"{interaction_loops} is not a valid option for interaction loops." + msg += f"\nMust be one of {valid_vals}" + warnings.warn(msg,stacklevel=2) + if "INTERACTION_LOOPS" not in self.param: + self.param["INTERACTION_LOOPS"] = valid_vals[0] + else: + self.param["INTERACTION_LOOPS"] = interaction_loops + update_list.append("interaction_loops") + + if encounter_check_loops is not None: + valid_vals = ["TRIANGULAR", "SORTSWEEP", "ADAPTIVE"] + if encounter_check_loops not in valid_vals: + msg = f"{encounter_check_loops} is not a valid option for interaction loops." + msg += f"\nMust be one of {valid_vals}" + warnings.warn(msg,stacklevel=2) + if "ENCOUNTER_CHECK" not in self.param: + self.param["ENCOUNTER_CHECK"] = valid_vals[0] + else: + self.param["ENCOUNTER_CHECK"] = encounter_check_loops + update_list.append("encounter_check_loops") + + if encounter_save is not None: + valid_vals = ["NONE", "TRAJECTORY", "CLOSEST", "BOTH"] + encounter_save = encounter_save.upper() + if encounter_save not in valid_vals: + msg = f"{encounter_save} is not a valid option for encounter_save." + msg += f"\nMust be one of {valid_vals}" + warnings.warn(msg,stacklevel=2) + if "ENCOUNTER_SAVE" not in self.param: + self.param["ENCOUNTER_SAVE"] = valid_vals[0] + else: + self.param["ENCOUNTER_SAVE"] = encounter_save + update_list.append("encounter_save") + + self.param["TIDES"] = False + + feature_dict = self.get_feature(update_list, verbose) + return feature_dict + + def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | None = None, **kwargs: Any): + """ + + Returns a subset of the parameter dictionary containing the current value of the feature boolean values. + If the verbose option is set in the Simulation object, then it will also print the values. + + Parameters + ---------- + arg_list: str | List[str], optional + A single string or list of strings containing the names of the features to extract. Default is all of: + ["close_encounter_check", "general_relativity", "collision_model", "rotation", "compute_conservation_values"] + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + get_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. + + Returns + ------- + feature_dict : dict + A dictionary containing the requested features. + + """ + + valid_var = {"close_encounter_check": "CHK_CLOSE", + "collision_model": "COLLISION_MODEL", + "encounter_save": "ENCOUNTER_SAVE", + "minimum_fragment_gmass": "MIN_GMFRAG", + "rotation": "ROTATION", + "general_relativity": "GR", + "compute_conservation_values": "ENERGY", + "rhill_present": "RHILL_PRESENT", + "extra_force": "EXTRA_FORCE", + "big_discard": "BIG_DISCARD", + "interaction_loops": "INTERACTION_LOOPS", + "encounter_check_loops": "ENCOUNTER_CHECK", + "restart": "RESTART" + } + + valid_arg, feature_dict = self._get_valid_arg_list(arg_list, valid_var) + + if verbose is None: + verbose = self.verbose + + if verbose: + for arg in valid_arg: + key = valid_var[arg] + if key in feature_dict: + if arg == "minimum_fragment_gmass": + print(f"{arg:<{self._getter_column_width}} {feature_dict[key]} {self.DU_name}^3 / {self.TU_name}^2 ") + print(f"{'minimum_fragment_mass':<{self._getter_column_width}} {feature_dict[key] / self.GU} {self.MU_name}") + else: + print(f"{arg:<{self._getter_column_width}} {feature_dict[key]}") + else: + print(f"{arg:<{self._getter_column_width}} NOT SET") + + + return feature_dict + + def set_init_cond_files(self, + init_cond_file_type: Literal["NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"] | None = None, + init_cond_file_name: str | os.PathLike | Dict[str, str] | + Dict[ str, os.PathLike] | None = None, + init_cond_format: Literal["EL", "XV"] | None = None, + verbose: bool | None = None, + **kwargs: Any + ): + """ + Sets the initial condition file parameters in the parameters dictionary. + + Parameters + ---------- + init_cond_file_type : {"NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"}, optional + The file type containing initial conditions for the simulation: + * NETCDF_DOUBLE: A single initial conditions input file in NetCDF file format of type NETCDF_DOUBLE + * NETCDF_FLOAT: A single initial conditions input file in NetCDF file format of type NETCDF_FLOAT + * ASCII : Three initial conditions files in ASCII format. The individual files define the central body, + massive body, and test particle initial conditions. + init_cond_file_name : str, path-like, or dict, optional + Name of the input initial condition file or files. Whether to pass a single file name or a dictionary + depends on the argument passed to `init_cond_file_type`: If `init_cond_file_type={"NETCDF_DOUBLE","NETCDF_FLOAT"}`, + then this will be a single file name. If `init_cond_file_type="ASCII"` then this must be a dictionary where: + ```init_cond_file_name = { + "CB" : *path to central body initial conditions file* (Swiftest only), + "PL" : *path to massive body initial conditions file*, + "TP" : *path to test particle initial conditions file* + }``` + If no file name is provided then the following default file names will be used. + * NETCDF_DOUBLE, NETCDF_FLOAT: `init_cond_file_name = "init_cond.nc"` + * ASCII: `init_cond_file_name = {"CB" : "cb.in", "PL" : "pl.in", "TP" : "tp.in"}` + init_cond_format : {"EL", "XV"} + Indicates whether the input initial conditions are given as orbital elements or cartesian position and + velocity vectors. + > *Note:* If `codename` is "Swift" or "Swifter", EL initial conditions are converted to XV. + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + set_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. + + Returns + ------- + init_cond_file_dict : dict + A dictionary containing the requested parameters + + """ + + update_list = [] + if init_cond_file_name is not None: + update_list.append("init_cond_file_name") + if init_cond_file_type is not None: + update_list.append("init_cond_file_type") + if init_cond_format is not None: + update_list.append("init_cond_format") + + if len(update_list) == 0: + return {} + + def ascii_file_input_error_msg(codename): + msg = f"in set_init_cond_files: init_cond_file_name must be a dictionary of the form: " + msg += "\n {" + if codename == "Swiftest": + msg += '\n"CB" : *path to central body initial conditions file*,' + msg += '\n"PL" : *path to massive body initial conditions file*,' + msg += '\n"TP" : *path to test particle initial conditions file*' + msg += '\n}' + warnings.warn(msg,stacklevel=2) + return {} + + if init_cond_format is None: + if "IN_FORM" in self.param: + init_cond_format = self.param['IN_FORM'] + else: + init_cond_format = "EL" + + if init_cond_file_type is None: + if "IN_TYPE" in self.param: + init_cond_file_type = self.param['IN_TYPE'] + else: + init_cond_file_type = "NETCDF_DOUBLE" + + if self.codename.title() == "Swiftest": + init_cond_keys = ["CB", "PL", "TP"] + else: + init_cond_keys = ["PL", "TP"] + if init_cond_file_type != "ASCII": + warnings.warn(f"{init_cond_file_type} is not supported by {self.codename}. Using ASCII instead",stacklevel=2) + init_cond_file_type = "ASCII" + if init_cond_format != "XV": + warnings.warn(f"{init_cond_format} is not supported by {self.codename}. Using XV instead",stacklevel=2) + init_cond_format = "XV" + + valid_formats = {"EL", "XV"} + if init_cond_format not in valid_formats: + warnings.warn(f"{init_cond_format} is not a valid input format",stacklevel=2) + else: + self.param['IN_FORM'] = init_cond_format + + valid_types = {"NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"} + if init_cond_file_type not in valid_types: + warnings.warn(f"{init_cond_file_type} is not a valid input type",stackevel=2) + else: + self.param['IN_TYPE'] = init_cond_file_type + + if init_cond_file_type == "ASCII": + if init_cond_file_name is None: + # No file names passed, so we will just use the defaults. + for key in init_cond_keys: + self.param[f"{key}_IN"] = f"{key.lower()}.in" + elif type(init_cond_file_name) is not dict: + # Oops, accidentally passed a single string or path-like instead of the expected dictionary for ASCII + # input type. + ascii_file_input_error_msg(self.codename) + elif not all(key in init_cond_file_name for key in init_cond_keys): + # This is the case where the dictionary doesn't have all the keys we expect. Print an error message. + ascii_file_input_error_msg(self.codename) + else: + # A valid initial conditions file dictionary was passed. + for key in init_cond_keys: + self.param[f"{key}_IN"] = init_cond_file_name[key] + else: + if init_cond_file_name is None: + # No file names passed, so we will just use the default. + self.param["NC_IN"] = "init_cond.nc" + elif type(init_cond_file_name) is dict: + # Oops, accidentally passed a dictionary instead of the expected single string or path-like for NetCDF + # input type. + warnings.warn(f"Only a single input file is used for NetCDF files",stacklevel=2) + else: + self.param["NC_IN"] = init_cond_file_name + + init_cond_file_dict = self.get_init_cond_files(update_list, verbose) + + return init_cond_file_dict + + def get_init_cond_files(self, arg_list: str | List[str] | None = None, verbose: bool | None = None, **kwargs): + """ + + Returns a subset of the parameter dictionary containing the current initial condition file parameters + If the verbose option is set in the Simulation object, then it will also print the values. + + Parameters + ---------- + arg_list : str | List[str], optional + A single string or list of strings containing the names of the simulation time parameters to extract. + Default is all of: + ["init_cond_file_type", "init_cond_file_name", "init_cond_format"] + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + get_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. + + + Returns + ------- + init_cond_file_dict : dict + A dictionary containing the requested parameters + + """ + + valid_var = {"init_cond_file_type": "IN_TYPE", + "init_cond_format": "IN_FORM", + "init_cond_file_name": "NC_IN", + "init_cond_file_name['CB']": "CB_IN", + "init_cond_file_name['PL']": "PL_IN", + "init_cond_file_name['TP']": "TP_IN", + } + + three_file_args = ["init_cond_file_name['CB']", + "init_cond_file_name['PL']", + "init_cond_file_name['TP']"] + + if self.codename == "Swifter": + three_file_args.remove("init_cond_file_name['CB']") + valid_var.pop("init_cond_file_name['CB']",None) + + # We have to figure out which initial conditions file model we are using (1 vs. 3 files) + if arg_list is None: + valid_arg = list(valid_var.keys()) + elif type(arg_list) is str: + valid_arg = [arg_list] + else: + valid_arg = [k for k in arg_list if k in list(valid_var.keys())] + + # Figure out which input file model we need to use + if "init_cond_file_name" in valid_arg: + if self.param["IN_TYPE"] == "ASCII": + valid_arg.remove("init_cond_file_name") + for key in three_file_args: + if key not in valid_arg: + valid_arg.append(key) + else: + for key in three_file_args: + if key in valid_arg: + valid_arg.remove(key) + + valid_arg, init_cond_file_dict = self._get_valid_arg_list(valid_arg, valid_var) + + if verbose is None: + verbose = self.verbose + + if verbose: + for arg in valid_arg: + key = valid_var[arg] + print(f"{arg:<{self._getter_column_width}} {init_cond_file_dict[key]}") + + return init_cond_file_dict + + def set_output_files(self, + output_file_type: Literal[ + "NETCDF_DOUBLE", "NETCDF_FLOAT", "REAL4", "REAL8", "XDR4", "XDR8"] | None = None, + output_file_name: os.PathLike | str | None = None, + output_format: Literal["XV", "XVEL"] | None = None, + restart: bool | None = None, + verbose: bool | None = None, + **kwargs: Any + ): + """ + Sets the output file parameters in the parameter dictionary. + + Parameters + ---------- + output_file_type : {"NETCDF_DOUBLE", "NETCDF_FLOAT","REAL4","REAL8","XDR4","XDR8"}, optional + The file type for the outputs of the simulation. Compatible file types depend on the `codename` argument. + * Swiftest: Only "NETCDF_DOUBLE" or "NETCDF_FLOAT" supported. + * Swifter: Only "REAL4","REAL8","XDR4" or "XDR8" supported. + * Swift: Only "REAL4" supported. + output_file_name : str or path-like, optional + Name of output file to generate. If not supplied, then one of the default file names are used, depending on + the value passed to `output_file_type`. If one of the NetCDF types are used, the default is "data.nc". + Otherwise, the default is "bin.dat". + output_format : {"XV","XVEL"}, optional + Specifies the format for the data saved to the output file. If "XV" then cartesian position and velocity + vectors for all bodies are stored. If "XVEL" then the orbital elements are also stored. + restart: bool, optional + Indicates whether this is a restart of an old run or a new run. + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + set_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. + + Returns + ------- + output_file_dict : dict + A dictionary containing the requested parameters + + """ + update_list = [] + if output_file_type is not None: + update_list.append("output_file_type") + if output_file_name is not None: + update_list.append("output_file_name") + if output_format is not None: + update_list.append("output_format") + if restart is not None: + self.restart = restart + update_list.append("restart") + if len(update_list) == 0: + return {} + + if self.codename == "Swiftest": + if output_file_type is None: + output_file_type = self.param.pop("OUT_TYPE", None) + if output_file_type is None: + output_file_type = "NETCDF_DOUBLE" + elif output_file_type not in ["NETCDF_DOUBLE", "NETCDF_FLOAT"]: + warnings.warn(f"{output_file_type} is not compatible with Swiftest. Setting to NETCDF_DOUBLE",stacklevel=2) + output_file_type = "NETCDF_DOUBLE" + elif self.codename == "Swifter": + if output_file_type is None: + output_file_type = self.param.pop("OUT_TYPE", None) + if output_file_type is None: + output_file_type = "REAL8" + elif output_file_type not in ["REAL4", "REAL8", "XDR4", "XDR8"]: + warnings.warn(f"{output_file_type} is not compatible with Swifter. Setting to REAL8",stacklevel=2) + output_file_type = "REAL8" + elif self.codename == "Swift": + if output_file_type is None: + output_file_type = self.param.pop("OUT_TYPE", None) + if output_file_type is None: + output_file_type = "REAL4" + if output_file_type not in ["REAL4"]: + warnings.warn(f"{output_file_type} is not compatible with Swift. Setting to REAL4",stacklevel=2) + output_file_type = "REAL4" + + self.param['OUT_TYPE'] = output_file_type + if output_file_name is None: + if output_file_type in ["NETCDF_DOUBLE", "NETCDF_FLOAT"]: + self.param['BIN_OUT'] = "data.nc" + else: + self.param['BIN_OUT'] = "bin.dat" + else: + self.param['BIN_OUT'] = output_file_name + + if output_format != "XV" and self.codename != "Swiftest": + warnings.warn(f"{output_format} is not compatible with {self.codename}. Setting to XV",stacklevel=2) + output_format = "XV" + self.param["OUT_FORM"] = output_format + + if self.restart: + self.param["OUT_STAT"] = "APPEND" + else: + self.param["OUT_STAT"] = "REPLACE" + + output_file_dict = self.get_output_files(update_list, verbose=verbose) + + return output_file_dict + + def get_output_files(self, arg_list: str | List[str] | None = None, verbose: bool | None = None, **kwargs): + """ + + Returns a subset of the parameter dictionary containing the current output file parameters + If the verbose option is set in the Simulation object, then it will also print the values. + + Parameters + ---------- + arg_list : str | List[str], optional + A single string or list of strings containing the names of the simulation time parameters to extract. + Default is all of: + ["output_file_type", "output_file_name", "output_format"] + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + get_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. + + + Returns + ------- + output_file_dict : dict + A dictionary containing the requested parameters + + """ + + valid_var = {"output_file_type": "OUT_TYPE", + "output_file_name": "BIN_OUT", + "output_format": "OUT_FORM", + "restart": "OUT_STAT" + } + + valid_arg, output_file_dict = self._get_valid_arg_list(arg_list, valid_var) + + if verbose is None: + verbose = self.verbose + + if verbose: + for arg in valid_arg: + key = valid_var[arg] + print(f"{arg:<{self._getter_column_width}} {output_file_dict[key]}") + + return output_file_dict + + def set_unit_system(self, + MU: str | None = None, + DU: str | None = None, + TU: str | None = None, + MU2KG: float | None = None, + DU2M: float | None = None, + TU2S: float | None = None, + MU_name: str | None = None, + DU_name: str | None = None, + TU_name: str | None = None, + recompute_unit_values: bool = True, + verbose: bool | None = None, + **kwargs: Any): + """ + Setter for setting the unit conversion between one of the standard sets. + + The units can be set one of two ways: + 1) The user can supply string values to the arguments MU, DU, and TU to select between common systems + 2) The user can supply float values to the arguments MU2KG, DU2M, and TU2S to manually set the conversion + factor between the desired unit and the SI unit (kg-m-s). + + The two sets of arguments are mutually exclusive. Any values passed to MU2KG, DU2M, or TU2S will override any + specified in MU, DU, or TU, respectively. The default system is Msun-AU-YR. MU, DU, and TU are case-insenstive + + Parameters + ---------- + MU : str, optional + The mass unit system to use. Case-insensitive valid options are: + "Msun" : Solar mass + "Mearth" : Earth mass + "kg" : kilograms + "g" : grams + DU : str, optional + The distance unit system to use. Case-insensitive valid options are: + "AU" : Astronomical Unit + "Rearth" : Earth radius + "m" : meter + "cm" : centimeter + TU : str, optional + The time unit system to use. Case-insensitive valid options are: + "YR" : Year + "DAY" : Julian day + "d" : Julian day + "JD" : Julian day + "s" : second + MU2KG : float, optional + The conversion factor to multiply by the mass unit that would convert it to kilogram. + Setting this overrides MU + DU2M : float, optional + The conversion factor to multiply by the distance unit that would convert it to meter. + Setting this overrides DU + TU2S : float, optional + The conversion factor to multiply by the time unit that would convert it to seconds. + Setting this overrides TU + MU_name : str, optional + The name of the mass unit. When setting one of the standard units via `MU` a name will be + automatically set for the unit, so this argument will override the automatic name. + DU_name : str, optional + The name of the distance unit. When setting one of the standard units via `DU` a name will be + automatically set for the unit, so this argument will override the automatic name. + TU_name : str, optional + 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. + recompute_unit_values : bool, default True + Recompute all values into the new unit system. + >*Note:* This is a destructive operation, however if not executed then the values contained in the parameter + > file and input/output data files computed previously may not be consistent with the new unit conversion + > factors. + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + set_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. + + Returns + ---------- + unit_dict : dict + A dictionary containing the requested unit conversion parameters + """ + + MU2KG_old = None + DU2M_old = None + TU2S_old = None + + if "MU_name" not in dir(self): + self.MU_name = None + if "DU_name" not in dir(self): + self.DU_name = None + if "TU_name" not in dir(self): + self.TU_name = None + + update_list = [] + if MU is not None or MU2KG is not None: + update_list.append("MU") + if DU is not None or DU2M is not None: + update_list.append("DU") + if TU is not None or TU2S is not None: + update_list.append("TU") + + if MU2KG is not None or MU is not None: + MU2KG_old = self.param.pop('MU2KG', None) + if MU2KG is not None: + self.param['MU2KG'] = MU2KG + self.MU_name = None + else: + if MU.upper() == "MSUN": + self.param['MU2KG'] = constants.MSun + self.MU_name = "MSun" + elif MU.upper() == "MEARTH": + self.param['MU2KG'] = constants.MEarth + self.MU_name = "MEarth" + elif MU.upper() == "KG": + self.param['MU2KG'] = 1.0 + self.MU_name = "kg" + elif MU.upper() == "G": + self.param['MU2KG'] = 1000.0 + self.MU_name = "g" + else: + warnings.warn(f"{MU} not a recognized unit system. Using MSun as a default.",stacklevel=2) + self.param['MU2KG'] = constants.MSun + self.MU_name = "MSun" + + if DU2M is not None or DU is not None: + DU2M_old = self.param.pop('DU2M', None) + if DU2M is not None: + self.param['DU2M'] = DU2M + self.DU_name = None + else: + if DU.upper() == "AU": + self.param['DU2M'] = constants.AU2M + self.DU_name = "AU" + elif DU.upper() == "REARTH": + self.param['DU2M'] = constants.REarth + self.DU_name = "REarth" + elif DU.upper() == "M": + self.param['DU2M'] = 1.0 + self.DU_name = "m" + elif DU.upper() == "CM": + self.param['DU2M'] = 100.0 + self.DU_name = "cm" + else: + warnings.warn(f"{DU} not a recognized unit system. Using AU as a default.",stacklevel=2) + self.param['DU2M'] = constants.AU2M + self.DU_name = "AU" + + if TU2S is not None or TU is not None: + TU2S_old = self.param.pop('TU2S', None) + if TU2S is not None: + self.param['TU2S'] = TU2S + self.TU_name = None + else: + if TU.upper() == "YR" or TU.upper() == "Y" or TU.upper() == "YEAR" or TU.upper() == "YEARS": + self.param['TU2S'] = constants.YR2S + self.TU_name = "y" + elif TU.upper() == "DAY" or TU.upper() == "D" or TU.upper() == "JD" or TU.upper() == "DAYS": + self.param['TU2S'] = constants.JD2S + self.TU_name = "d" + elif TU.upper() == "S" or TU.upper() == "SECONDS" or TU.upper() == "SEC": + self.param['TU2S'] = 1.0 + self.TU_name = "s" + else: + warnings.warn(f"{TU} not a recognized unit system. Using YR as a default.",stacklevel=2) + self.param['TU2S'] = constants.YR2S + self.TU_name = "y" -class Simulation: - """ - This is a class that defines the basic Swift/Swifter/Swiftest simulation object - """ - def __init__(self, codename="Swiftest", param_file="param.in", readbin=True, verbose=True): - self.ds = xr.Dataset() - self.param = { - '! VERSION': f"Swiftest parameter input", - 'T0': "0.0", - 'TSTOP': "0.0", - 'DT': "0.0", - 'IN_FORM': "XV", - 'IN_TYPE': "NETCDF_DOUBLE", - 'NC_IN' : "init_cond.nc", - 'CB_IN' : "cb.in", - 'PL_IN' : "pl.in", - 'TP_IN' : "tp.in", - 'ISTEP_OUT': "1", - 'ISTEP_DUMP': "1", - 'BIN_OUT': "bin.nc", - 'OUT_TYPE': 'NETCDF_DOUBLE', - 'OUT_FORM': "XVEL", - 'OUT_STAT': "REPLACE", - 'CHK_RMAX': "-1.0", - 'CHK_EJECT': "-1.0", - 'CHK_RMIN': "-1.0", - 'CHK_QMIN': "-1.0", - 'CHK_QMIN_COORD': "HELIO", - 'CHK_QMIN_RANGE': "-1.0 -1.0", - 'ENC_OUT': "", - 'MU2KG': constants.MSun, - 'TU2S': constants.JD2S, - 'DU2M': constants.AU2M, - 'EXTRA_FORCE': "NO", - 'DISCARD_OUT': "", - 'PARTICLE_OUT' : "", - 'BIG_DISCARD': "NO", - 'CHK_CLOSE': "YES", - 'RHILL_PRESENT': "YES", - 'FRAGMENTATION': "NO", - 'ROTATION': "NO", - 'TIDES': "NO", - 'ENERGY': "NO", - 'GR': "YES", - 'INTERACTION_LOOPS': "TRIANGULAR", - 'ENCOUNTER_CHECK': "TRIANGULAR" + if MU_name is not None: + self.MU_name = MU_name + if DU_name is not None: + self.DU_name = DU_name + if TU_name is not None: + self.TU_name = TU_name + + if "DU_name" in dir(self) and "TU_name" in dir(self): + self.VU_name = f"{self.DU_name}/{self.TU_name}" + if all(key in self.param for key in ["MU2KG","DU2M","TU2S"]): + self.GU = constants.GC * self.param["TU2S"] ** 2 * self.param["MU2KG"] / self.param["DU2M"] ** 3 + + if recompute_unit_values and \ + MU2KG_old != self.param['MU2KG'] or \ + DU2M_old != self.param['DU2M'] or \ + TU2S_old != self.param['TU2S']: + self.update_param_units(MU2KG_old, DU2M_old, TU2S_old) + + unit_dict = self.get_unit_system(update_list, verbose) + + return unit_dict + + def get_unit_system(self, arg_list: str | List[str] | None = None, verbose: bool | None = None, **kwargs): + """ + + Returns a subset of the parameter dictionary containing the current simulation unit system. + If the verbose option is set in the Simulation object, then it will also print the values. + + Parameters + ---------- + arg_list : str | List[str], optional + A single string or list of strings containing the names of the simulation unit system + Default is all of: + ["MU", "DU", "TU"] + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + get_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. + + Returns + ------- + unit_dict : dict + A dictionary containing the requested unit conversion parameters + + """ + + valid_var = { + "MU": "MU2KG", + "DU": "DU2M", + "TU": "TU2S", } - self.codename = codename - self.verbose = verbose - if param_file != "" : - dir_path = os.path.dirname(os.path.realpath(param_file)) - self.read_param(param_file, codename=codename, verbose=self.verbose) - if readbin: - binpath = os.path.join(dir_path,self.param['BIN_OUT']) - if os.path.exists(binpath): - self.param['BIN_OUT'] = binpath - self.bin2xr() - else: - print(f"BIN_OUT file {self.param['BIN_OUT']} not found.") + + if "MU_name" not in dir(self) or self.MU_name is None: + MU_name = "mass unit" + else: + MU_name = self.MU_name + if "DU_name" not in dir(self) or self.DU_name is None: + DU_name = "distance unit" + else: + DU_name = self.DU_name + if "TU_name" not in dir(self) or self.TU_name is None: + TU_name = "time unit" + else: + TU_name = self.TU_name + + units1 = { + "MU": MU_name, + "DU": DU_name, + "TU": TU_name + } + units2 = { + "MU": f"kg / {MU_name}", + "DU": f"m / {DU_name}", + "TU": f"s / {TU_name}" + } + + valid_arg, unit_dict = self._get_valid_arg_list(arg_list, valid_var) + + if verbose is None: + verbose = self.verbose + + if verbose: + for arg in valid_arg: + key = valid_var[arg] + col_width = str(int(self._getter_column_width) - 4) + print(f"{arg}: {units1[arg]:<{col_width}} {unit_dict[key]} {units2[arg]}") + + return unit_dict + + def update_param_units(self, MU2KG_old, DU2M_old, TU2S_old): + """ + Updates the values of parameters that have units when the units have changed. + + Parameters + ---------- + MU2KG_old : Old value of the mass unit conversion factor + DU2M_old : Old value of the distance unit conversion factor + TU2S_old : Old value of the time unit conversion factor + + Returns + ------- + Updates the set of param dictionary values for the new unit system + + """ + + mass_keys = ['GMTINY', 'MIN_GMFRAG'] + distance_keys = ['CHK_QMIN', 'CHK_RMIN', 'CHK_RMAX', 'CHK_EJECT'] + time_keys = ['T0', 'TSTOP', 'DT'] + + if MU2KG_old is not None: + for k in mass_keys: + if k in self.param: + self.param[k] *= MU2KG_old / self.param['MU2KG'] + + if DU2M_old is not None: + for k in distance_keys: + if k in self.param: + self.param[k] *= DU2M_old / self.param['DU2M'] + + CHK_QMIN_RANGE = self.param.pop('CHK_QMIN_RANGE', None) + 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 + self.param['CHK_QMIN_RANGE'] = f"{CHK_QMIN_RANGE[0]} {CHK_QMIN_RANGE[1]}" + + if TU2S_old is not None: + for k in time_keys: + if k in self.param: + self.param[k] *= TU2S_old / self.param['TU2S'] + return - - def add(self, plname, date=date.today().isoformat(), idval=None): + + def set_distance_range(self, + rmin: float | None = None, + rmax: float | None = None, + qmin_coord: Literal["HELIO","BARY"] | None = None, + verbose: bool | None = None, + **kwargs: Any): """ - Adds a solar system body to an existing simulation DataSet. - + Sets the minimum and maximum distances of the simulation. + + Parameters + ---------- + rmin : float + Minimum distance of the simulation (CHK_QMIN, CHK_RMIN, CHK_QMIN_RANGE[0]) + rmax : float + Maximum distance of the simulation (CHK_RMAX, CHK_QMIN_RANGE[1]) + qmin_coord : str, {"HELIO", "BARY"} + coordinate frame to use for CHK_QMIN + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + set_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. + + Returns + ------- + range_dict : dict + A dictionary containing the requested parameters. + + """ + if rmax is None and rmin is None and qmin_coord is None: + return {} + + update_list = [] + CHK_QMIN_RANGE = self.param.pop('CHK_QMIN_RANGE', None) + if CHK_QMIN_RANGE is None: + CHK_QMIN_RANGE = [-1, -1] + else: + CHK_QMIN_RANGE = CHK_QMIN_RANGE.split(" ") + if rmin is not None: + self.param['CHK_QMIN'] = rmin + self.param['CHK_RMIN'] = rmin + CHK_QMIN_RANGE[0] = rmin + update_list.append("rmin") + if rmax is not None: + self.param['CHK_RMAX'] = rmax + self.param['CHK_EJECT'] = rmax + CHK_QMIN_RANGE[1] = rmax + update_list.append("rmax") + if qmin_coord is not None: + valid_qmin_coord = ["HELIO","BARY"] + if qmin_coord.upper() not in valid_qmin_coord: + warnings.warn(f"qmin_coord = {qmin_coord} is not a valid option. Must be one of",','.join(valid_qmin_coord),stacklevel=2) + self.param['CHK_QMIN_COORD'] = valid_qmin_coord[0] + else: + self.param['CHK_QMIN_COORD'] = qmin_coord.upper() + update_list.append("qmin_coord") + + self.param['CHK_QMIN_RANGE'] = f"{CHK_QMIN_RANGE[0]} {CHK_QMIN_RANGE[1]}" + + range_dict = self.get_distance_range(update_list, verbose=verbose) + + return range_dict + + def get_distance_range(self, arg_list: str | List[str] | None = None, verbose: bool | None = None, **kwargs: Any): + """ + + Returns a subset of the parameter dictionary containing the current values of the distance range parameters. + If the verbose option is set in the Simulation object, then it will also print the values. + + Parameters + ---------- + arg_list: str | List[str], optional + A single string or list of strings containing the names of the features to extract. Default is all of: + ["rmin", "rmax"] + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + get_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. + + Returns + ------- + range_dict : dict + A dictionary containing the requested parameters. + + """ + + valid_var = {"rmin": "CHK_RMIN", + "rmax": "CHK_RMAX", + "qmin_coord": "CHK_QMIN_COORD", + "qmin": "CHK_QMIN", + "qminR": "CHK_QMIN_RANGE" + } + + units = {"rmin": self.DU_name, + "rmax": self.DU_name, + "qmin": self.DU_name, + "qminR": self.DU_name, + } + + if type(arg_list) is str: + arg_list = [arg_list] + if arg_list is not None: + if "rmin" in arg_list: + arg_list.append("qmin") + if "rmax" in arg_list or "rmin" in arg_list: + arg_list.append("qminR") + + valid_arg, range_dict = self._get_valid_arg_list(arg_list, valid_var) + + if verbose is None: + verbose = self.verbose + + if verbose: + if "rmin" in valid_arg: + key = valid_var["rmin"] + print(f"{'rmin':<{self._getter_column_width}} {range_dict[key]} {units['rmin']}") + if "rmax" in valid_arg: + key = valid_var["rmax"] + print(f"{'rmax':<{self._getter_column_width}} {range_dict[key]} {units['rmax']}") + if "qmin_coord" in valid_arg: + key = valid_var["qmin_coord"] + print(f"{'qmin_coord':<{self._getter_column_width}} {range_dict[key]}") + + return range_dict + + def add_solar_system_body(self, + name: str | List[str], + ephemeris_id: int | List[int] | None = None, + date: str | None = None, + source: str = "HORIZONS"): + """ + Adds a solar system body to an existing simulation Dataset from the JPL Horizons ephemeris service. + + The following are name/ephemeris_id pairs that are currently known to Swiftest, and therefore have + physical properties that can be used to make massive bodies. + + Sun : 0 + Mercury : 1 + Venus : 2 + Earth : 3 + Mars : 4 + Jupiter : 5 + Saturn : 6 + Uranus : 7 + Neptune : 8 + Pluto : 9 + Parameters ---------- - plname : string - Name of planet to add (e.g. "Mercury", "Venus", "Earth", "Mars", "Jupiter", "Saturn", "Uranus", "Neptune" - date : string - Date to use when obtaining the ephemerides in the format YYYY-MM-DD. Defaults to "today" + name : str | List[str] + Add solar system body by name. + Bodies not on this list will be added as test particles, but additional properties can be added later if + desired. + ephemeris_id : int | List[int], optional but must be the same length as `name` if passed. + Use id if the body you wish to add is recognized by Swiftest. In that case, the id is passed to the + ephemeris service and the name is used. The body specified by `id` supercedes that given by `name`. + date : str, optional + ISO-formatted date sto use when obtaining the ephemerides in the format YYYY-MM-DD. Defaults to value + set by `set_ephemeris_date`. + source : str, default "Horizons" + The source of the ephemerides. + >*Note.* Currently only the JPL Horizons ephemeris is implemented, so this is ignored. Returns ------- - self.ds : xarray dataset + None + initial conditions data stored as an Xarray Dataset in the init_cond instance variable """ - #self.ds = init_cond.solar_system_horizons(plname, idval, self.param, date, self.ds) - self.addp(*init_cond.solar_system_horizons(plname, idval, self.param, date, self.ds)) + + if type(name) is str: + name = [name] + if ephemeris_id is not None: + if type(ephemeris_id) is int: + ephemeris_id = [ephemeris_id] + if len(ephemeris_id) != len(name): + warnings.warn(f"The length of ephemeris_id ({len(ephemeris_id)}) does not match the length of name ({len(name)})",stacklevel=2) + return None + else: + ephemeris_id = [None] * len(name) + + if self.ephemeris_date is None: + self.set_ephemeris_date() + + if date is None: + date = self.ephemeris_date + try: + datetime.datetime.fromisoformat(date) + except: + warnings.warn(f"{date} is not a valid date format. Must be 'YYYY-MM-DD'. Setting to {self.ephemeris_date}",stacklevel=2) + date = self.ephemeris_date + + if source.upper() != "HORIZONS": + warnings.warn("Currently only the JPL Horizons ephemeris service is supported",stacklevel=2) + + body_list = [] + for i,n in enumerate(name): + body_list.append(init_cond.solar_system_horizons(n, self.param, date, id=ephemeris_id[i])) + + #Convert the list receieved from the solar_system_horizons output and turn it into arguments to vec2xr + if len(body_list) == 1: + values = list(np.hsplit(np.array(body_list[0],dtype=np.dtype(object)),17)) + else: + values = list(np.squeeze(np.hsplit(np.array(body_list,np.dtype(object)),17))) + keys = ["id","name","a","e","inc","capom","omega","capm","rh","vh","Gmass","radius","rhill","Ip","rot","J2","J4"] + kwargs = dict(zip(keys,values)) + scalar_floats = ["a","e","inc","capom","omega","capm","Gmass","radius","rhill","J2","J4"] + vector_floats = ["rh","vh","Ip","rot"] + scalar_ints = ["id"] + + for k,v in kwargs.items(): + if k in scalar_ints: + kwargs[k] = v.astype(int) + elif k in scalar_floats: + kwargs[k] = v.astype(np.float64) + if all(np.isnan(kwargs[k])): + kwargs[k] = None + elif k in vector_floats: + kwargs[k] = np.vstack(v) + kwargs[k] = kwargs[k].astype(np.float64) + if np.all(np.isnan(kwargs[k])): + kwargs[k] = None + + kwargs['time'] = np.array([self.param['TSTART']]) + + dsnew = init_cond.vec2xr(self.param,**kwargs) + + dsnew = self._combine_and_fix_dsnew(dsnew) + if dsnew['npl'] > 0 or dsnew['ntp'] > 0: + self.save(verbose=False) + + self.init_cond = self.data.copy(deep=True) + return - - - def addp(self, idvals, namevals, v1, v2, v3, v4, v5, v6, GMpl=None, Rpl=None, rhill=None, Ip1=None, Ip2=None, Ip3=None, rotx=None, roty=None, rotz=None, J2=None,J4=None,t=None): + + def set_ephemeris_date(self, + ephemeris_date: str | None = None, + verbose: bool | None = None, + **kwargs: Any): + """ + + Parameters + ---------- + ephemeris_date : str, optional + Date to use when obtaining the ephemerides. + Valid options are "today", "MBCL", or date in the format YYYY-MM-DD. + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + set_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. + + Returns + ------- + Sets the `ephemeris_date` instance variable. + + """ + + if ephemeris_date is None: + return + + # The default value is Prof. Minton's Brimley/Cocoon line crossing date (aka MBCL) + minton_bday = datetime.date.fromisoformat('1976-08-05') + brimley_cocoon_line = datetime.timedelta(days=18530) + minton_bcl = (minton_bday + brimley_cocoon_line).isoformat() + + if ephemeris_date is None or ephemeris_date.upper() == "MBCL": + ephemeris_date = minton_bcl + elif ephemeris_date.upper() == "TODAY": + ephemeris_date = datetime.date.today().isoformat() + else: + try: + datetime.datetime.fromisoformat(ephemeris_date) + except: + valid_date_args = ['"MBCL"', '"TODAY"', '"YYYY-MM-DD"'] + msg = f"{ephemeris_date} is not a valid format. Valid options include:", ', '.join(valid_date_args) + msg += "\nUsing MBCL for date." + warnings.warn(msg,stacklevel=2) + ephemeris_date = minton_bcl + + self.ephemeris_date = ephemeris_date + + ephemeris_date = self.get_ephemeris_date(verbose=verbose) + + return ephemeris_date + + def get_ephemeris_date(self, arg_list: str | List[str] | None = None, verbose: bool | None = None, **kwargs: Any): + """ + + Prints the current value of the ephemeris date + + Parameters + ---------- + arg_list: str | List[str], optional + A single string or list of strings containing the names of the features to extract. Default is all of: + ["integrator"] + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + get_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. + + Returns + ------- + ephemeris_date: str + The ISO-formatted date string for the ephemeris computation + + """ + + try: + self.ephemeris_date + except: + warnings.warn(f"ephemeris_date is not set",stacklevel=2) + return + + valid_arg = {"ephemeris_date": self.ephemeris_date} + + ephemeris_date = self._get_instance_var(arg_list, valid_arg,verbose, **kwargs) + + return ephemeris_date + + def _get_instance_var(self, arg_list: str | List[str], valid_arg: Dict, verbose: bool | None = None, **kwargs: Any): + """ + + Prints the current value of an instance variable. + + Parameters + ---------- + arg_list: str | List[str] + A single string or list of strings containing the names of the the instance variable to get. + valid_arg: dict + A dictionary where the key is the parameter argument and the value is the equivalent instance variable value. + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + get_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. + + Returns + ------- + Tuple of instance variable values given by the arg_list + + """ + + arg_vals = [] + if verbose is None: + verbose = self.verbose + if verbose: + if arg_list is None: + arg_list = list(valid_arg.keys()) + for arg in arg_list: + if arg in valid_arg: + print(f"{arg:<{self._getter_column_width}} {valid_arg[arg]}") + arg_vals.append(valid_arg[arg]) + + return tuple(arg_vals) + + def add_body(self, + name: str | List[str] | npt.NDArray[np.str_] | None=None, + id: int | list[int] | npt.NDArray[np.int_] | None=None, + a: float | List[float] | npt.NDArray[np.float_] | None = None, + e: float | List[float] | npt.NDArray[np.float_] | None = None, + inc: float | List[float] | npt.NDArray[np.float_] | None = None, + capom: float | List[float] | npt.NDArray[np.float_] | None = None, + omega: float | List[float] | npt.NDArray[np.float_] | None = None, + capm: float | List[float] | npt.NDArray[np.float_] | None = None, + rh: List[float] | List[npt.NDArray[np.float_]] | npt.NDArray[np.float_] | None = None, + vh: List[float] | List[npt.NDArray[np.float_]] | npt.NDArray[np.float_] | None = None, + mass: float | List[float] | npt.NDArray[np.float_] | None=None, + Gmass: float | List[float] | npt.NDArray[np.float_] | None=None, + radius: float | List[float] | npt.NDArray[np.float_] | None=None, + 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, + J2: float | List[float] | npt.NDArray[np.float_] | None=None, + J4: float | List[float] | npt.NDArray[np.float_] | None=None): """ Adds a body (test particle or massive body) to the internal DataSet given a set up 6 vectors (orbital elements - or cartesian state vectors, depending on the value of self.param). Input all angles in degress - - Parameters - ---------- - idvals : integer - Array of body index values. - v1 : float - xh for param['IN_FORM'] == "XV"; a for param['IN_FORM'] == "EL" - v2 : float - yh for param['IN_FORM'] == "XV"; e for param['IN_FORM'] == "EL" - v3 : float - zh for param['IN_FORM'] == "XV"; inc for param['IN_FORM'] == "EL" - v4 : float - vhxh for param['IN_FORM'] == "XV"; capom for param['IN_FORM'] == "EL" - v5 : float - vhyh for param['IN_FORM'] == "XV"; omega for param['IN_FORM'] == "EL" - v6 : float - vhzh for param['IN_FORM'] == "XV"; capm for param['IN_FORM'] == "EL" - Gmass : float - Optional: Array of G*mass values if these are massive bodies - radius : float - Optional: Array radius values if these are massive bodies - rhill : float - Optional: Array rhill values if these are massive bodies - Ip1,y,z : float - Optional: Principal axes moments of inertia - rotx,y,z: float - Optional: Rotation rate vector components - t : float - Optional: Time at start of simulation + or cartesian state vectors, depending on the value of self.param). Input all angles in degress. + + This method will update self.data with the new body or bodies added to the existing Dataset. + + Parameters + ---------- + name : str or array-like of str, optional + Name or names of Bodies. If none passed, name will be "Body" + id : int or array-like of int, optional + Unique id values. If not passed, an id will be assigned in ascending order starting from the pre-existing + Dataset ids. + a : float or array-like of float, optional + semimajor axis for param['IN_FORM'] == "EL" + e : float or array-like of float, optional + eccentricity for param['IN_FORM'] == "EL" + inc : float or array-like of float, optional + inclination for param['IN_FORM'] == "EL" + capom : float or array-like of float, optional + longitude of ascending node for param['IN_FORM'] == "EL" + omega : float or array-like of float, optional + argument of periapsis for param['IN_FORM'] == "EL" + capm : float or array-like of float, optional + mean anomaly for param['IN_FORM'] == "EL" + rh : (n,3) array-like of float, optional + Position vector array. + vh : (n,3) array-like of float, optional + Velocity vector array. + mass : float or array-like of float, optional + mass values if these are massive bodies (only one of mass or Gmass can be passed) + Gmass : float or array-like of float, optional + G*mass values if these are massive bodies (only one of mass or Gmass can be passed) + radius : float or array-like of float, optional + Radius values if these are massive bodies + rhill : float or array-like of float, optional + Hill's radius values if these are massive bodies + rot: (3) or (n,3) array-like of float, optional + Rotation rate vectors if these are massive bodies with rotation enabled. + Ip: (3) or (n,3) array-like of flaot, optional + Principal axes moments of inertia vectors if these are massive bodies with rotation enabled. + Returns ------- - self.ds : xarray dataset + data : Xarray Dataset + Dasaset containing the body or bodies that were added + """ - if t is None: - t = self.param['T0'] - dsnew = init_cond.vec2xr(self.param, idvals, namevals, v1, v2, v3, v4, v5, v6, GMpl, Rpl, rhill, Ip1, Ip2, Ip3, rotx, roty, rotz, J2, J4, t) - if dsnew is not None: - self.ds = xr.combine_by_coords([self.ds, dsnew]) - self.ds['ntp'] = self.ds['id'].where(np.isnan(self.ds['Gmass'])).count(dim="id") - self.ds['npl'] = self.ds['id'].where(np.invert(np.isnan(self.ds['Gmass']))).count(dim="id") - 1 + #convert all inputs to numpy arrays + def input_to_array(val,t,n=None): + if t == "f": + t = np.float64 + elif t == "i": + t = np.int64 + elif t == "s": + t = np.str + + if val is None: + return None, n + elif isinstance(val, np.ndarray): + pass + elif np.isscalar(val): + val = np.array([val],dtype=t) + else: + try: + val = np.array(val,dtype=t) + except: + raise ValueError(f"{val} cannot be converted to a numpy array") + + if n is None: + return val, len(val) + else: + if n != len(val): + raise ValueError(f"Mismatched array lengths in add_body. Got {len(val)} when expecting {n}") + return val, n + + def input_to_array_3d(val,n=None): + 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") + if n is None: + ndims = len(val.shape) + if ndims > 2 or ndims == 0: + raise ValueError(f"Argument must be an (n,3) or (3,) array. This one is {val.shape}") + else: + if val.shape[-1] != 3: + raise ValueError(f"Argument must be a 3-dimensional vector. This one has {val.shape[0]}!") + if val.dim == 1: + n = 1 + else: + n = val.shape[0] + elif n == 1: + if val.shape != (1,3) and val.shape != (3,): + raise ValueError(f"Argument is an incorrect shape. Expected {(n,3)} or {(3,1)}. Got {val.shape} instead") + elif val.shape == (3,): + val = np.expand_dims(val,axis=0) + elif val.shape != (n,3) and val.shape != (3,n): + raise ValueError(f"Argument is an incorrect shape. Expected {(n,3)} or {(3,n)}. Got {val.shape} instead") + elif val.shape == (3,n): + val = val.T + + return val, n + + nbodies = None + name,nbodies = input_to_array(name,"s",nbodies) + a,nbodies = input_to_array(a,"f",nbodies) + e,nbodies = input_to_array(e,"f",nbodies) + inc,nbodies = input_to_array(inc,"f",nbodies) + capom,nbodies = input_to_array(capom,"f",nbodies) + omega,nbodies = input_to_array(omega,"f",nbodies) + capm,nbodies = input_to_array(capm,"f",nbodies) + id,nbodies = input_to_array(id,"i",nbodies) + mass,nbodies = input_to_array(mass,"f",nbodies) + Gmass,nbodies = input_to_array(Gmass,"f",nbodies) + rhill,nbodies = input_to_array(rhill,"f",nbodies) + radius,nbodies = input_to_array(radius,"f",nbodies) + J2,nbodies = input_to_array(J2,"f",nbodies) + J4,nbodies = input_to_array(J4,"f",nbodies) + + rh,nbodies = input_to_array_3d(rh,nbodies) + vh,nbodies = input_to_array_3d(vh,nbodies) + rot,nbodies = input_to_array_3d(rot,nbodies) + Ip,nbodies = input_to_array_3d(Ip,nbodies) + + if len(self.data) == 0: + maxid = -1 + else: + maxid = self.data.id.max().values[()] + + if id is None: + id = np.arange(start=maxid+1,stop=maxid+1+nbodies,dtype=int) + + if name is None: + name=np.char.mod(f"Body%d",id) + + if len(self.data) > 0: + dup_id = np.in1d(id, self.data.id) + if any(dup_id): + raise ValueError(f"Duplicate ids detected: ", *id[dup_id]) + + time = [self.param['TSTART']] + + if mass is not None: + if Gmass is not None: + raise ValueError("Cannot use mass and Gmass inputs simultaneously!") + else: + Gmass = self.param['GU'] * mass + + 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, J2=J2, J4=J4, time=time) + + dsnew = self._combine_and_fix_dsnew(dsnew) + self.save(verbose=False) + self.init_cond = self.data.copy(deep=True) return - - - def read_param(self, param_file, codename="Swiftest", verbose=True): + + def _combine_and_fix_dsnew(self,dsnew): + """ + Combines the new Dataset with the old one. Also computes the values of ntp and npl and sets the proper types. + Parameters + ---------- + dsnew : xarray Dataset + Dataset with new bodies + + Returns + ------- + dsnew : xarray Dataset + Updated Dataset with ntp, npl values and types fixed. + + """ + if "id" not in self.data.dims: + if len(np.unique(dsnew['name'])) == len(dsnew['name']): + dsnew = dsnew.swap_dims({"id" : "name"}) + if "id" in dsnew: + dsnew = dsnew.reset_coords("id") + else: + msg = "Non-unique names detected for bodies. The Dataset will be dimensioned by integer id instead of name." + msg +="\nConsider using unique names instead." + print(msg) + + self.data = xr.combine_by_coords([self.data, dsnew]) + + if self.param['OUT_TYPE'] == "NETCDF_DOUBLE": + dsnew = io.fix_types(dsnew, ftype=np.float64) + self.data = io.fix_types(self.data, ftype=np.float64) + elif self.param['OUT_TYPE'] == "NETCDF_FLOAT": + dsnew = io.fix_types(dsnew, ftype=np.float32) + self.data = io.fix_types(self.data, ftype=np.float32) + + def get_nvals(ds): + if "name" in ds.dims: + count_dim = "name" + elif "id" in ds.dims: + count_dim = "id" + if "Gmass" in ds: + ds['ntp'] = ds[count_dim].where(np.isnan(ds['Gmass'])).count(dim=count_dim) + ds['npl'] = ds[count_dim].where(~(np.isnan(ds['Gmass']))).count(dim=count_dim) - 1 + if self.integrator == "symba" and "GMTINY" in self.param and self.param['GMTINY'] is not None: + ds['nplm'] = ds[count_dim].where(ds['Gmass'] > self.param['GMTINY']).count(dim=count_dim) - 1 + else: + ds['ntp'] = ds[count_dim].count(dim=count_dim) + ds['npl'] = xr.full_like(ds['ntp'],0) + if self.integrator == "symba" and "GMTINY" in self.param and self.param['GMTINY'] is not None: + ds['nplm'] = xr.full_like(ds['ntp'],0) + return ds + + dsnew = get_nvals(dsnew) + self.data = get_nvals(self.data) + + self.data = self.data.sortby("id") + self.data = io.reorder_dims(self.data) + + return dsnew + + def read_param(self, + param_file : os.PathLike | str | None = None, + codename: Literal["Swiftest", "Swifter", "Swift"] | None = None, + read_init_cond : Bool | None = None, + verbose: bool | None = None): """ - Reads in a param.in file and determines whether it is a Swift/Swifter/Swiftest parameter file. + Reads in an input parameter file and stores the values in the param dictionary. Parameters ---------- - param_file : string - File name of the input parameter file - codename : string - Type of parameter file, either "Swift", "Swifter", or "Swiftest" + param_file : str or path-like, default is the value of the Simulation object's internal `param_file`. + File name of the input parameter file + codename : {"Swiftest", "Swifter", "Swift"}, default is the value of the Simulation object's internal`codename` + Type of parameter file, either "Swift", "Swifter", or "Swiftest" + read_init_cond : bool, optional + If true, will read in the initial conditions file into the data instance variable. Default True + verbose : bool, default is the value of the Simulation object's internal `verbose` + If set to True, then more information is printed by Simulation methods as they are executed. Setting to + False suppresses most messages other than errors. Returns ------- - self.ds : xarray dataset + True if the parameter file exists and is read correctly. False otherwise. """ + if param_file is None: + param_file = self.param_file + if read_init_cond is None: + read_init_cond = True + if codename is None: + codename = self.codename + + if verbose is None: + verbose = self.verbose + + if not os.path.exists(param_file): + return False + if codename == "Swiftest": self.param = io.read_swiftest_param(param_file, self.param, verbose=verbose) - self.codename = "Swiftest" + if read_init_cond: + if "NETCDF" in self.param['IN_TYPE']: + init_cond_file = self.simdir / self.param['NC_IN'] + if os.path.exists(init_cond_file): + param_tmp = self.param.copy() + param_tmp['BIN_OUT'] = init_cond_file + self.data = io.swiftest2xr(param_tmp, verbose=self.verbose) + self.init_cond = self.data.copy(deep=True) + else: + warnings.warn(f"Initial conditions file file {init_cond_file} not found.", stacklevel=2) + else: + warnings.warn("Reading in ASCII initial conditions files in Python is not yet supported") elif codename == "Swifter": self.param = io.read_swifter_param(param_file, verbose=verbose) - self.codename = "Swifter" elif codename == "Swift": self.param = io.read_swift_param(param_file, verbose=verbose) - self.codename = "Swift" else: - print(f'{codename} is not a recognized code name. Valid options are "Swiftest", "Swifter", or "Swift".') - self.codename = "Unknown" - return - - - def write_param(self, param_file, param=None): + warnings.warn(f'{codename} is not a recognized code name. Valid options are "Swiftest", "Swifter", or "Swift".',stacklevel=2) + return False + + return True + + def write_param(self, + codename: Literal["Swiftest", "Swifter", "Swift"] | None = None, + param_file: str | os.PathLike | None = None, + param: Dict | None = None, + **kwargs: Any): """ Writes to a param.in file and determines whether the output format needs to be converted between Swift/Swifter/Swiftest. Parameters ---------- - param_file : string - File name of the input parameter file + codename : {"Swiftest", "Swifter", "Swift"}, optional + Alternative name of the n-body code that the parameter file will be formatted for. Defaults to current instance + variable codename + param_file : str or path-like, optional + Alternative file name of the input parameter file. Defaults to current instance variable self.param_file + param: Dict, optional + An alternative parameter dictionary to write out. Defaults to the current instance variable self.param + **kwargs + A dictionary of additional keyword argument. These are ignored. + Returns ------- - self.ds : xarray dataset + None """ + + if codename is None: + codename = self.codename + if param_file is None: + param_file = self.param_file if param is None: param = self.param + + if "verbose" in kwargs: + verbose = kwargs['verbose'] + else: + verbose = self.verbose + + if verbose: + print(f"Writing parameter inputs to file {param_file}") + param['! VERSION'] = f"{codename} input file" + + self.simdir.mkdir(parents=True, exist_ok=True) # Check to see if the parameter type matches the output type. If not, we need to convert - codename = param['! VERSION'].split()[0] if codename == "Swifter" or codename == "Swiftest": if param['IN_TYPE'] == "ASCII": param.pop("NC_IN", None) else: - param.pop("CB_IN",None) - param.pop("PL_IN",None) - param.pop("TP_IN",None) + param.pop("CB_IN", None) + param.pop("PL_IN", None) + param.pop("TP_IN", None) io.write_labeled_param(param, param_file) elif codename == "Swift": io.write_swift_param(param, param_file) else: - print('Cannot process unknown code type. Call the read_param method with a valid code name. Valid options are "Swiftest", "Swifter", or "Swift".') + warnings.warn('Cannot process unknown code type. Call the read_param method with a valid code name. Valid options are "Swiftest", "Swifter", or "Swift".',stacklevel=2) return - - - def convert(self, param_file, newcodename="Swiftest", plname="pl.swiftest.in", tpname="tp.swiftest.in", cbname="cb.swiftest.in", conversion_questions={}): + + def convert(self, param_file, newcodename="Swiftest", plname="pl.swiftest.in", tpname="tp.swiftest.in", + cbname="cb.swiftest.in", conversion_questions={}): """ Converts simulation input files from one format to another (Swift, Swifter, or Swiftest). Parameters ---------- - param_file : string - File name of the input parameter file - newcodename : string - Name of the desired format (Swift/Swifter/Swiftest) - plname : string - File name of the massive body input file - tpname : string - File name of the test particle input file - cbname : string - File name of the central body input file - conversion_questions : dictronary - Dictionary of additional parameters required to convert between formats + param_file : string + File name of the input parameter file + newcodename : string + Name of the desired format (Swift/Swifter/Swiftest) + plname : string + File name of the massive body input file + tpname : string + File name of the test particle input file + cbname : string + File name of the central body input file + conversion_questions : dictronary + Dictionary of additional parameters required to convert between formats Returns ------- - oldparam : xarray dataset - The old parameter configuration. + oldparam : xarray dataset + The old parameter configuration. """ oldparam = self.param if self.codename == newcodename: - print(f"This parameter configuration is already in {newcodename} format") + warnings.warn(f"This parameter configuration is already in {newcodename} format",stacklevel=2) return oldparam if newcodename != "Swift" and newcodename != "Swifter" and newcodename != "Swiftest": - print(f'{newcodename} is an invalid code type. Valid options are "Swiftest", "Swifter", or "Swift".') + warnings.warn(f'{newcodename} is an invalid code type. Valid options are "Swiftest", "Swifter", or "Swift".',stacklevel=2) return oldparam goodconversion = True if self.codename == "Swifter": @@ -254,38 +2698,105 @@ def convert(self, param_file, newcodename="Swiftest", plname="pl.swiftest.in", t goodconversion = False else: goodconversion = False - + if goodconversion: self.write_param(param_file) else: - print(f"Conversion from {self.codename} to {newcodename} is not supported.") + warnings.warn(f"Conversion from {self.codename} to {newcodename} is not supported.",stacklevel=2) return oldparam - - - def bin2xr(self): + + def read_output_file(self,read_init_cond : bool = True): """ - Converts simulation output files from a flat binary file to a xarray dataset. + Reads in simulation data from an output file and stores it as an Xarray Dataset in the `data` instance variable. Parameters ---------- + read_init_cond : bool + Read in an initial conditions file along with the output file. Default is True Returns ------- - self.ds : xarray dataset + self.data : xarray dataset """ + + # Make a temporary copy of the parameter dictionary so we can supply the absolute path of the binary file + # This is done to handle cases where the method is called from a different working directory than the simulation + # results + + param_tmp = self.param.copy() + param_tmp['BIN_OUT'] = os.path.join(self.simdir, self.param['BIN_OUT']) if self.codename == "Swiftest": - self.ds = io.swiftest2xr(self.param, verbose=self.verbose) - if self.verbose: print('Swiftest simulation data stored as xarray DataSet .ds') + self.data = io.swiftest2xr(param_tmp, verbose=self.verbose) + if self.verbose: + print('Swiftest simulation data stored as xarray DataSet .data') + if read_init_cond: + if self.verbose: + print("Reading initial conditions file as .init_cond") + if "NETCDF" in self.param['IN_TYPE']: + param_tmp['BIN_OUT'] = self.simdir / self.param['NC_IN'] + self.init_cond = io.swiftest2xr(param_tmp, verbose=False) + else: + self.init_cond = self.data.isel(time=0) + + self.read_encounters() + self.read_collisions() + if self.verbose: + print("Finished reading Swiftest dataset files.") + elif self.codename == "Swifter": - self.ds = io.swifter2xr(self.param, verbose=self.verbose) - if self.verbose: print('Swifter simulation data stored as xarray DataSet .ds') + self.data = io.swifter2xr(param_tmp, verbose=self.verbose) + if self.verbose: print('Swifter simulation data stored as xarray DataSet .data') elif self.codename == "Swift": - print("Reading Swift simulation data is not implemented yet") + warnings.warn("Reading Swift simulation data is not implemented yet",stacklevel=2) else: - print('Cannot process unknown code type. Call the read_param method with a valid code name. Valid options are "Swiftest", "Swifter", or "Swift".') + warnings.warn('Cannot process unknown code type. Call the read_param method with a valid code name. Valid options are "Swiftest", "Swifter", or "Swift".',stacklevel=2) + return + + def read_encounters(self): + enc_files = glob(f"{self.simdir}{os.path.sep}encounter_*.nc") + if len(enc_files) == 0: + return + + if self.verbose: + print("Reading encounter history file as .encounters") + + enc_files.sort() + + # This is needed in order to pass the param argument down to the io.process_netcdf_input function + def _preprocess(ds, param): + return io.process_netcdf_input(ds,param) + partial_func = partial(_preprocess, param=self.param) + + self.encounters = xr.open_mfdataset(enc_files,parallel=True,combine="nested",concat_dim="time",join="left",preprocess=partial_func,mask_and_scale=True) + self.encounters = io.process_netcdf_input(self.encounters, self.param) + # Remove any overlapping time values + tgood,tid = np.unique(self.encounters.time,return_index=True) + self.encounters = self.encounters.isel(time=tid) + # Remove any NaN values + tgood=self.encounters.time.where(~np.isnan(self.encounters.time),drop=True) + self.encounters = self.encounters.sel(time=tgood) + return - - + + def read_collisions(self): + col_files = glob(f"{self.simdir}{os.path.sep}collision_*.nc") + if len(col_files) == 0: + return + + col_files.sort() + if self.verbose: + print("Reading collision history file as .collisions") + + # This is needed in order to pass the param argument down to the io.process_netcdf_input function + def _preprocess(ds, param): + return io.process_netcdf_input(ds,param) + partial_func = partial(_preprocess, param=self.param) + + self.collisions = xr.open_mfdataset(col_files,parallel=True, coords=["collision"], join="inner", preprocess=partial_func,mask_and_scale=True) + self.collisions = io.process_netcdf_input(self.collisions, self.param) + + return + def follow(self, codestyle="Swifter"): """ An implementation of the Swift tool_follow algorithm. Under development. Currently only for Swift simulations. @@ -299,66 +2810,90 @@ def follow(self, codestyle="Swifter"): ------- fol : xarray dataset """ - if self.ds is None: - self.bin2xr() + if self.data is None: + self.read_output_file() if codestyle == "Swift": try: with open('follow.in', 'r') as f: - line = f.readline() # Parameter file (ignored because bin2xr already takes care of it - line = f.readline() # PL file (ignored) - line = f.readline() # TP file (ignored) - line = f.readline() # ifol + line = f.readline() # Parameter file (ignored because read_output_file already takes care of it + line = f.readline() # PL file (ignored) + line = f.readline() # TP file (ignored) + line = f.readline() # ifol i_list = [i for i in line.split(" ") if i.strip()] ifol = int(i_list[0]) line = f.readline() # nskp i_list = [i for i in line.split(" ") if i.strip()] nskp = int(i_list[0]) except IOError: - print('No follow.in file found') + warnings.warn('No follow.in file found',stacklevel=2) ifol = None nskp = None - fol = tool.follow_swift(self.ds, ifol=ifol, nskp=nskp) + fol = tool.follow_swift(self.data, ifol=ifol, nskp=nskp) else: fol = None - + if self.verbose: print('follow.out written') return fol - - - def save(self, param_file, framenum=-1, codename="Swiftest"): + + def save(self, + codename: Literal["Swiftest", "Swifter", "Swift"] | None = None, + param_file: str | os.PathLike | None = None, + param: Dict | None = None, + framenum: int = -1, + **kwargs: Any): """ Saves an xarray dataset to a set of input files. Parameters ---------- - param_file : string - Name of the parameter input file - framenum : integer (default=-1) - Time frame to use to generate the initial conditions. If this argument is not passed, the default is to use the last frame in the dataset. - codename : string - Name of the desired format (Swift/Swifter/Swiftest) + codename : {"Swiftest", "Swifter", "Swift"}, optional + Alternative name of the n-body code that the parameter file will be formatted for. Defaults to current instance + variable self.codename + param_file : str or path-like, optional + Alternative file name of the input parameter file. Defaults to current instance variable self.param_file + param: Dict, optional + An alternative parameter dictionary to write out. Defaults to the current instance variable self.param + framenum : int Default=-1 + Time frame to use to generate the initial conditions. If this argument is not passed, the default is to use the last frame in the dataset. + **kwargs + A dictionary of additional keyword argument. These are ignored. Returns ------- - self.ds : xarray dataset + None """ + if "verbose" in kwargs: + verbose = kwargs['verbose'] + else: + verbose = self.verbose + + if codename is None: + codename = self.codename + if param_file is None: + param_file = self.param_file + if param is None: + param = self.param + + self.simdir.mkdir(parents=True, exist_ok=True) if codename == "Swiftest": - io.swiftest_xr2infile(ds=self.ds, param=self.param, in_type=self.param['IN_TYPE'], framenum=framenum,infile_name=self.param['NC_IN']) - self.write_param(param_file) + infile_name = Path(self.simdir) / param['NC_IN'] + io.swiftest_xr2infile(ds=self.data, param=param, in_type=self.param['IN_TYPE'], infile_name=infile_name, framenum=framenum, verbose=verbose) + self.write_param(param_file=param_file,**kwargs) elif codename == "Swifter": - if self.codename == "Swiftest": - swifter_param = io.swiftest2swifter_param(self.param) + if codename == "Swiftest": + swifter_param = io.swiftest2swifter_param(param) else: - swifter_param = self.param - io.swifter_xr2infile(self.ds, swifter_param, framenum) - self.write_param(param_file, param=swifter_param) + swifter_param = param + io.swifter_xr2infile(self.data, swifter_param, framenum) + self.write_param(param_file, param=swifter_param,**kwargs) else: - print(f'Saving to {codename} not supported') + warnings.warn(f'Saving to {codename} not supported',stacklevel=2) return - def initial_conditions_from_bin(self, framenum=-1, new_param=None, new_param_file="param.new.in", new_initial_conditions_file="bin_in.nc", restart=False, codename="Swiftest"): + def initial_conditions_from_bin(self, framenum=-1, new_param=None, new_param_file="param.new.in", + new_initial_conditions_file="bin_in.nc", restart=False, codename="Swiftest"): """ Generates a set of input files from a old output file. @@ -379,40 +2914,67 @@ def initial_conditions_from_bin(self, framenum=-1, new_param=None, new_param_fil Returns ------- - frame : NetCDF dataset + frame : NetCDF dataset + A dataset containing the extracted initial condition data. """ - + frame = None if codename != "Swiftest": self.save(new_param_file, framenum, codename) return + if new_param is None: new_param = self.param.copy() if codename == "Swiftest": if restart: - new_param['T0'] = self.ds.time.values[framenum] - if self.param['OUT_TYPE'] == 'NETCDF_DOUBLE' or self.param['OUT_TYPE'] == 'REAL8': + new_param['T0'] = self.data.time.values[framenum] + if self.param['OUT_TYPE'] == 'NETCDF_DOUBLE': new_param['IN_TYPE'] = 'NETCDF_DOUBLE' - elif self.param['OUT_TYPE'] == 'NETCDF_FLOAT' or self.param['OUT_TYPE'] == 'REAL4': + elif self.param['OUT_TYPE'] == 'NETCDF_FLOAT': new_param['IN_TYPE'] = 'NETCDF_FLOAT' else: - print(f"{self.param['OUT_TYPE']} is an invalid OUT_TYPE file") + warnings.warn(f"{self.param['OUT_TYPE']} is an invalid OUT_TYPE file",stacklevel=2) return + if self.param['BIN_OUT'] != new_param['BIN_OUT'] and restart: - print(f"Restart run with new output file. Copying {self.param['BIN_OUT']} to {new_param['BIN_OUT']}") - shutil.copy2(self.param['BIN_OUT'],new_param['BIN_OUT']) + print(f"Restart run with new output file. Copying {self.param['BIN_OUT']} to {new_param['BIN_OUT']}") + shutil.copy2(self.param['BIN_OUT'], new_param['BIN_OUT']) + new_param['IN_FORM'] = 'XV' if restart: new_param['OUT_STAT'] = 'APPEND' + new_param['FIRSTKICK'] = 'T' new_param['NC_IN'] = new_initial_conditions_file new_param.pop('PL_IN', None) new_param.pop('TP_IN', None) new_param.pop('CB_IN', None) print(f"Extracting data from dataset at time frame number {framenum} and saving it to {new_param['NC_IN']}") - frame = io.swiftest_xr2infile(self.ds, self.param, infile_name=new_param['NC_IN'],framenum=framenum) + frame = io.swiftest_xr2infile(self.data, self.param, infile_name=new_param['NC_IN'], framenum=framenum) print(f"Saving parameter configuration file to {new_param_file}") self.write_param(new_param_file, param=new_param) return frame + + def clean(self): + """ + Cleans up simulation directory by deleting old files (dump, logs, and output files). + """ + old_files = [self.simdir / self.param['BIN_OUT'], + self.simdir / "fraggle.log", + self.simdir / "swiftest.log", + ] + glob_files = [self.simdir.glob("**/dump_param?.in")] \ + + [self.simdir.glob("**/dump_bin?.nc")] \ + + [self.simdir.glob("**/encounter_*.nc")] \ + + [self.simdir.glob("**/collision_*.nc")] + + for f in old_files: + if f.exists(): + os.remove(f) + for g in glob_files: + for f in g: + if f.exists(): + os.remove(f) + return diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 25411a4dc..ef6b91f5e 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -12,122 +12,105 @@ ######################################## # Add the source files -SET(FOO_src - ${SRC}/modules/encounter_classes.f90 - ${SRC}/modules/fraggle_classes.f90 - ${SRC}/modules/helio_classes.f90 - ${SRC}/modules/lambda_function.f90 - ${SRC}/modules/rmvs_classes.f90 - ${SRC}/modules/swiftest_classes.f90 - ${SRC}/modules/swiftest_globals.f90 - ${SRC}/modules/swiftest_operators.f90 - ${SRC}/modules/swiftest.f90 - ${SRC}/modules/symba_classes.f90 - ${SRC}/modules/walltime_classes.f90 - ${SRC}/modules/whm_classes.f90 - ${SRC}/discard/discard.f90 - ${SRC}/drift/drift.f90 +SET(STRICT_MATH_FILES + ${SRC}/swiftest/swiftest_kick.f90 + ${SRC}/helio/helio_kick.f90 + ${SRC}/rmvs/rmvs_kick.f90 + ${SRC}/symba/symba_kick.f90 + ${SRC}/whm/whm_kick.f90 + ${SRC}/swiftest/swiftest_user.f90 +) + +SET(FAST_MATH_FILES + ${SRC}/globals/globals_module.f90 + ${SRC}/base/base_module.f90 + ${SRC}/netcdf_io/netcdf_io_module.f90 + ${SRC}/misc/lambda_function_module.f90 + ${SRC}/misc/io_progress_bar_module.f90 + ${SRC}/misc/solver_module.f90 + ${SRC}/encounter/encounter_module.f90 + ${SRC}/collision/collision_module.f90 + ${SRC}/operator/operator_module.f90 + ${SRC}/walltime/walltime_module.f90 + ${SRC}/swiftest/swiftest_module.f90 + ${SRC}/whm/whm_module.f90 + ${SRC}/rmvs/rmvs_module.f90 + ${SRC}/helio/helio_module.f90 + ${SRC}/symba/symba_module.f90 + ${SRC}/fraggle/fraggle_module.f90 + ${SRC}/collision/collision_check.f90 + ${SRC}/collision/collision_generate.f90 + ${SRC}/collision/collision_io.f90 + ${SRC}/collision/collision_regime.f90 + ${SRC}/collision/collision_resolve.f90 + ${SRC}/collision/collision_util.f90 ${SRC}/encounter/encounter_check.f90 ${SRC}/encounter/encounter_io.f90 - ${SRC}/encounter/encounter_setup.f90 ${SRC}/encounter/encounter_util.f90 ${SRC}/fraggle/fraggle_generate.f90 - ${SRC}/fraggle/fraggle_io.f90 - ${SRC}/fraggle/fraggle_placeholder.f90 - ${SRC}/fraggle/fraggle_regime.f90 - ${SRC}/fraggle/fraggle_set.f90 - ${SRC}/fraggle/fraggle_setup.f90 ${SRC}/fraggle/fraggle_util.f90 - ${SRC}/gr/gr.f90 ${SRC}/helio/helio_drift.f90 ${SRC}/helio/helio_gr.f90 - ${SRC}/helio/helio_kick.f90 - ${SRC}/helio/helio_setup.f90 ${SRC}/helio/helio_step.f90 ${SRC}/helio/helio_util.f90 - ${SRC}/io/io.f90 - ${SRC}/kick/kick.f90 - ${SRC}/netcdf/netcdf.f90 - ${SRC}/obl/obl.f90 - ${SRC}/operators/operator_cross.f90 - ${SRC}/operators/operator_mag.f90 - ${SRC}/orbel/orbel.f90 + ${SRC}/netcdf_io/netcdf_io_implementations.f90 + ${SRC}/operator/operator_cross.f90 + ${SRC}/operator/operator_mag.f90 + ${SRC}/operator/operator_unit.f90 ${SRC}/rmvs/rmvs_discard.f90 ${SRC}/rmvs/rmvs_encounter_check.f90 - ${SRC}/rmvs/rmvs_io.f90 - ${SRC}/rmvs/rmvs_kick.f90 - ${SRC}/rmvs/rmvs_setup.f90 ${SRC}/rmvs/rmvs_step.f90 ${SRC}/rmvs/rmvs_util.f90 - ${SRC}/setup/setup.f90 - ${SRC}/symba/symba_collision.f90 + ${SRC}/swiftest/swiftest_discard.f90 + ${SRC}/swiftest/swiftest_drift.f90 + ${SRC}/swiftest/swiftest_gr.f90 + ${SRC}/swiftest/swiftest_io.f90 + ${SRC}/swiftest/swiftest_kick.f90 + ${SRC}/swiftest/swiftest_obl.f90 + ${SRC}/swiftest/swiftest_orbel.f90 + ${SRC}/swiftest/swiftest_util.f90 ${SRC}/symba/symba_discard.f90 ${SRC}/symba/symba_drift.f90 ${SRC}/symba/symba_encounter_check.f90 ${SRC}/symba/symba_gr.f90 ${SRC}/symba/symba_io.f90 - ${SRC}/symba/symba_kick.f90 - ${SRC}/symba/symba_setup.f90 ${SRC}/symba/symba_step.f90 ${SRC}/symba/symba_util.f90 - ${SRC}/tides/tides_getacch_pl.f90 - ${SRC}/tides/tides_spin_step.f90 - ${SRC}/user/user_getacch.f90 - ${SRC}/util/util_append.f90 - ${SRC}/util/util_coord.f90 - ${SRC}/util/util_copy.f90 - ${SRC}/util/util_dealloc.f90 - ${SRC}/util/util_exit.f90 - ${SRC}/util/util_fill.f90 - ${SRC}/util/util_flatten.f90 - ${SRC}/util/util_get_energy_momentum.f90 - ${SRC}/util/util_index_array.f90 - ${SRC}/util/util_minimize_bfgs.f90 - ${SRC}/util/util_peri.f90 - ${SRC}/util/util_rescale.f90 - ${SRC}/util/util_resize.f90 - ${SRC}/util/util_set.f90 - ${SRC}/util/util_solve.f90 - ${SRC}/util/util_sort.f90 - ${SRC}/util/util_spill.f90 - ${SRC}/util/util_valid.f90 - ${SRC}/util/util_version.f90 - ${SRC}/walltime/walltime.f90 + ${SRC}/walltime/walltime_implementations.f90 ${SRC}/whm/whm_coord.f90 ${SRC}/whm/whm_drift.f90 ${SRC}/whm/whm_gr.f90 - ${SRC}/whm/whm_kick.f90 - ${SRC}/whm/whm_setup.f90 ${SRC}/whm/whm_step.f90 ${SRC}/whm/whm_util.f90 - ${SRC}/main/swiftest_driver.f90 + ${SRC}/swiftest/swiftest_driver.f90 ) + +set(SWIFTEST_src ${FAST_MATH_FILES} ${STRICT_MATH_FILES}) + # Define the executable in terms of the source files -ADD_EXECUTABLE(${FOOEXE} ${FOO_src}) +ADD_EXECUTABLE(${SWIFTEST_DRIVER} ${SWIFTEST_src}) ##################################################### # Add the needed libraries and special compiler flags ##################################################### -# Uncomment if you need to link to BLAS and LAPACK -TARGET_LINK_LIBRARIES(${FOOEXE} ${NETCDF_LIBRARIES} ${NETCDF_FORTRAN_LIBRARIES}) +# # Uncomment if you need to link to BLAS and LAPACK +TARGET_LINK_LIBRARIES(${SWIFTEST_DRIVER} ${NETCDF_LIBRARIES} ${NETCDF_FORTRAN_LIBRARIES}) -# Uncomment if you have parallization IF(USE_OPENMP) - SET_TARGET_PROPERTIES(${FOOEXE} PROPERTIES + SET_TARGET_PROPERTIES(${SWIFTEST_DRIVER} PROPERTIES COMPILE_FLAGS "${OpenMP_Fortran_FLAGS}" LINK_FLAGS "${OpenMP_Fortran_FLAGS}") ELSEIF(USE_MPI) - SET_TARGET_PROPERTIES(${FOOEXE} PROPERTIES + SET_TARGET_PROPERTIES(${SWIFTEST_DRIVER} PROPERTIES COMPILE_FLAGS "${MPI_Fortran_COMPILE_FLAGS}" LINK_FLAGS "${MPI_Fortran_LINK_FLAGS}") INCLUDE_DIRECTORIES(${MPI_Fortran_INCLUDE_PATH}) - TARGET_LINK_LIBRARIES(${FOOEXE} ${MPI_Fortran_LIBRARIES}) + TARGET_LINK_LIBRARIES(${SWIFTEST_DRIVER} ${MPI_Fortran_LIBRARIES}) ENDIF(USE_OPENMP) - ##################################### # Tell how to install this executable ##################################### @@ -137,4 +120,13 @@ IF(WIN32) ELSE() SET(CMAKE_INSTALL_PREFIX /usr/local) ENDIF(WIN32) -INSTALL(TARGETS ${FOOEXE} RUNTIME DESTINATION bin) \ No newline at end of file +INSTALL(TARGETS ${SWIFTEST_DRIVER} RUNTIME DESTINATION bin) + + +#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}") +ENDIF() + diff --git a/src/base/base_module.f90 b/src/base/base_module.f90 new file mode 100644 index 000000000..bda2c6406 --- /dev/null +++ b/src/base/base_module.f90 @@ -0,0 +1,317 @@ +!! 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. + +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. + !! + use globals + implicit none + public + + + !> 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(len=:), allocatable :: integrator !! Symbolic name of the nbody integrator used + character(len=:), allocatable :: param_file_name !! The name of the parameter file + integer(I4B) :: maxid = -1 !! The current maximum particle id number + integer(I4B) :: maxid_collision = 0 !! The current maximum collision id number + 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(I4B) :: ioutput = 1 !! Output counter + 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) :: in_netcdf = 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 + 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 + 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" + + ! The following are used internally, and 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 :: ladaptive_interactions = .false. !! Adaptive interaction loop is turned on (choose between TRIANGULAR and FLAT based on periodic timing tests) + 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 :: ladaptive_encounters_plpl = .false. !! Adaptive encounter checking is turned on (choose between TRIANGULAR or SORTSWEEP based on periodic timing tests) + logical :: ladaptive_encounters_pltp = .false. !! Adaptive encounter checking is turned on (choose between TRIANGULAR or SORTSWEEP based on periodic timing tests) + + ! 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 + + ! 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) :: Eorbit_orig = 0.0_DP !! Initial orbital energy + real(DP) :: GMtot_orig = 0.0_DP !! Initial system mass + real(DP), dimension(NDIM) :: Ltot_orig = 0.0_DP !! Initial total angular momentum vector + real(DP), dimension(NDIM) :: Lorbit_orig = 0.0_DP !! Initial orbital angular momentum + real(DP), dimension(NDIM) :: Lspin_orig = 0.0_DP !! Initial spin angular momentum vector + real(DP), dimension(NDIM) :: Lescape = 0.0_DP !! Angular momentum of bodies that escaped the system (used for bookeeping) + real(DP) :: GMescape = 0.0_DP !! Mass of bodies that escaped the system (used for bookeeping) + real(DP) :: Ecollisions = 0.0_DP !! Energy lost from system due to collisions + real(DP) :: Euntracked = 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(len=:), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT"}). Default is "STANDARD" + 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 + + ! 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 + contains + procedure(abstract_io_dump_param), deferred :: dump + procedure(abstract_io_param_reader), deferred :: reader + procedure(abstract_io_param_writer), deferred :: writer + procedure(abstract_io_read_in_param), deferred :: read_in + end type base_parameters + + abstract interface + 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) + 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 + 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 + 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) + end subroutine abstract_io_read_in_param + end interface + + + type :: base_storage_frame + class(*), allocatable :: item + contains + procedure :: store => copy_store !! Stores a snapshot of the nbody system so that later it can be retrieved for saving to file. + generic :: assignment(=) => store + final :: final_storage_frame + end type + + + type, abstract :: base_storage(nframes) + !! An class that establishes the pattern for various storage objects + integer(I4B), len :: nframes = 4096 !! Total number of frames that can be stored + + !! An class that establishes the pattern for various storage objects + type(base_storage_frame), dimension(nframes) :: 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 :: reset => reset_storage !! Resets a storage object by deallocating all items and resetting the frame counter to 0 + end type base_storage + + + !> Class definition for the particle origin information object. This object is used to track time, location, and collisional regime + !> of fragments produced in collisional events. + type, abstract :: base_particle_info + end type base_particle_info + + + !> An abstract class for a generic collection of Swiftest bodies + type, abstract :: base_object + end type base_object + + + type, abstract :: base_multibody(nbody) + integer(I4B), len :: nbody + integer(I4B), dimension(nbody) :: id + end type base_multibody + + + !> Class definition for the kinship relationships used in bookkeeping multiple collisions bodies in a single time step. + type, abstract :: base_kinship + end type base_kinship + + + !> An abstract class for a basic Swiftest nbody system + type, abstract :: base_nbody_system + end type base_nbody_system + + contains + + subroutine 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. + implicit none + 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) + + return + end subroutine copy_store + + + subroutine final_storage_frame(self) + !! author: David A. Minton + !! + !! Finalizer for the storage frame data type + implicit none + type(base_storage_frame) :: self + + if (allocated(self%item)) deallocate(self%item) + + return + end subroutine final_storage_frame + + + subroutine base_final_storage(self) + !! author: David A. Minton + !! + !! Finalizer for the storage object + implicit none + ! Arguments + class(base_storage(*)), intent(inout) :: self + ! Internals + integer(I4B) :: i + + do i = 1, self%nframes + call final_storage_frame(self%frame(i)) + end do + return + end subroutine base_final_storage + + + subroutine reset_storage(self) + !! 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 + ! Internals + integer(I4B) :: i + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) + end do + + if (allocated(self%idmap)) deallocate(self%idmap) + if (allocated(self%tmap)) deallocate(self%tmap) + self%nid = 0 + self%nt = 0 + self%iframe = 0 + + return + end subroutine reset_storage + + + + subroutine util_exit(code) + !! author: David A. Minton + !! + !! Print termination message and exit program + !! + !! Adapted from David E. Kaufmann's Swifter routine: util_exit.f90 + !! Adapted from Hal Levison's Swift routine util_exit.f + implicit none + ! Arguments + integer(I4B), intent(in) :: code + ! Internals + character(*), parameter :: BAR = '("------------------------------------------------")' + character(*), parameter :: SUCCESS_MSG = '(/, "Normal termination of Swiftest (version ", f3.1, ")")' + character(*), parameter :: FAIL_MSG = '(/, "Terminating Swiftest (version ", f3.1, ") due to error!!")' + character(*), parameter :: USAGE_MSG = '("Usage: swiftest [bs|helio|ra15|rmvs|symba|tu4|whm] [standard|compact|progress|NONE]")' + character(*), parameter :: HELP_MSG = USAGE_MSG + + select case(code) + case(SUCCESS) + write(*, SUCCESS_MSG) VERSION_NUMBER + write(*, BAR) + case(USAGE) + write(*, USAGE_MSG) + case(HELP) + write(*, HELP_MSG) + case default + write(*, FAIL_MSG) VERSION_NUMBER + write(*, BAR) + error stop + end select + + stop + + end subroutine util_exit + +end module base diff --git a/src/collision/collision_check.f90 b/src/collision/collision_check.f90 new file mode 100644 index 000000000..1f88c98aa --- /dev/null +++ b/src/collision/collision_check.f90 @@ -0,0 +1,265 @@ + +!! 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. + +submodule (collision) s_collision_check + use swiftest + use symba, only : symba_pl, symba_tp +contains + + pure elemental subroutine collision_check_one(xr, yr, zr, vxr, vyr, vzr, Gmtot, rlim, dt, lvdotr, lcollision, lclosest) + !! author: David A. Minton + !! + !! Check for a merger between a single pair of particles + !! + !! Adapted from David E. Kaufmann's Swifter routines symba_merge_tp.f90 and symba_merge_pl.f90 + !! + !! Adapted from Hal Levison's Swift routine symba5_merge.f + implicit none + ! Arguments + real(DP), intent(in) :: xr, yr, zr !! Relative position vector components + real(DP), intent(in) :: vxr, vyr, vzr !! Relative velocity vector components + real(DP), intent(in) :: Gmtot !! Sum of G*mass of colliding bodies + real(DP), intent(in) :: rlim !! Collision limit - Typically the sum of the radii of colliding bodies + 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 + ! Internals + real(DP) :: r2, rlim2, a, e, q, vdotr, tcr2, dt2 + + r2 = xr**2 + yr**2 + zr**2 + rlim2 = rlim**2 + 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 + lcollision = .false. + vdotr = xr * vxr + yr * vyr + zr * vzr + if (lvdotr .and. (vdotr > 0.0_DP)) then + tcr2 = r2 / (vxr**2 + vyr**2 + vzr**2) + dt2 = dt**2 + if (tcr2 <= dt2) then + call swiftest_orbel_xv2aeq(Gmtot, xr, yr, zr, vxr, vyr, vzr, a, e, q) + lcollision = (q < rlim) + end if + lclosest = .not. lcollision + end if + end if + + return + end subroutine collision_check_one + + + module subroutine collision_check_plpl(self, nbody_system, param, t, dt, irec, lany_collision) + !! author: David A. Minton + !! + !! Check for merger between massive bodies and test particles in SyMBA + !! + !! Adapted from David E. Kaufmann's Swifter routine symba_merge.f90 and symba_merge_tp.f90 + !! + !! 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 + ! Internals + logical, dimension(:), allocatable :: lcollision, lmask + real(DP), dimension(NDIM) :: xr, vr + integer(I4B) :: i, j, k, nenc + real(DP) :: rlim, Gmtot + logical :: lany_closest + + lany_collision = .false. + if (self%nenc == 0) return + + select type(nbody_system) + class is (swiftest_nbody_system) + associate(pl => nbody_system%pl) + + nenc = self%nenc + allocate(lmask(nenc)) + lmask(:) = (self%status(1:nenc) == ACTIVE) + select type(pl) + class is (symba_pl) + lmask(:) = lmask(:).and. (pl%levelg(self%index1(1:nenc)) >= irec) + end select + if (.not.any(lmask(:))) return + + allocate(lcollision(nenc)) + lcollision(:) = .false. + self%lclosest(:) = .false. + + do concurrent(k = 1:nenc, lmask(k)) + i = self%index1(k) + j = self%index2(k) + xr(:) = pl%rh(:, i) - pl%rh(:, j) + 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)) + 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 + do k = 1, nenc + if (.not.lcollision(k) .and. .not. self%lclosest(k)) cycle + i = self%index1(k) + j = self%index2(k) + self%r1(:,k) = pl%rh(:,i) + nbody_system%cb%rb(:) + self%v1(:,k) = pl%vb(:,i) + if (lcollision(k)) then + self%status(k) = COLLIDED + self%tcollision(k) = t + end if + 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 + 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 + pl%lcollision([i, j]) = .true. + pl%status([i, j]) = COLLIDED + call pl%info(i)%set_value(status="COLLIDED") + call pl%info(j)%set_value(status="COLLIDED") + end if + + end do + + ! Extract the pl-pl encounter list and return the pl-pl collision_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 + return + end subroutine collision_check_plpl + + + module subroutine collision_check_pltp(self, nbody_system, param, t, dt, irec, lany_collision) + !! author: David A. Minton + !! + !! Check for merger between massive bodies and test particles in SyMBA + !! + !! Adapted from David E. Kaufmann's Swifter routine symba_merge.f90 and symba_merge_tp.f90 + !! + !! 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 + ! Internals + logical, dimension(:), allocatable :: lcollision, lmask + real(DP), dimension(NDIM) :: xr, vr + integer(I4B) :: i, j, k, nenc + real(DP) :: rlim + logical :: lany_closest + character(len=STRMAX) :: timestr, idstri, idstrj, message + class(collision_list_pltp), allocatable :: tmp + + 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 + allocate(lmask(nenc)) + lmask(:) = (self%status(1:nenc) == ACTIVE) + select type(pl) + class is (symba_pl) + select type(tp) + class is (symba_tp) + lmask(:) = lmask(:) .and. (tp%levelg(self%index2(1:nenc)) >= irec) + end select + end select + if (.not.any(lmask(:))) return + + allocate(lcollision(nenc)) + lcollision(:) = .false. + self%lclosest(:) = .false. + + + do concurrent(k = 1:nenc, lmask(k)) + i = self%index1(k) + 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)) + 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 + do k = 1, nenc + if (.not.lcollision(k) .and. .not. self%lclosest(k)) cycle + i = self%index1(k) + j = self%index2(k) + self%r1(:,k) = pl%rh(:,i) + nbody_system%cb%rb(:) + self%v1(:,k) = pl%vb(:,i) + if (lcollision(k)) then + self%status(k) = COLLIDED + self%tcollision(k) = t + end if + + self%r2(:,k) = tp%rh(:,j) + nbody_system%cb%rb(:) + self%v2(:,k) = tp%vb(:,j) + if (lcollision(k)) then + tp%status(j) = DISCARDED_PLR + tp%ldiscard(j) = .true. + write(idstri, *) pl%id(i) + write(idstrj, *) tp%id(j) + 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)) + !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 + 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 + +end submodule s_collision_check \ No newline at end of file diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 new file mode 100644 index 000000000..b946a387e --- /dev/null +++ b/src/collision/collision_generate.f90 @@ -0,0 +1,242 @@ + +!! 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. + +submodule(collision) s_collision_generate + use swiftest +contains + + module subroutine collision_generate_basic(self, nbody_system, param, t) + !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Merge massive bodies no matter the regime + !! + !! Adapted from David E. Kaufmann's Swifter routines symba_merge_pl.f90 and symba_discard_merge_pl.f90 + !! + !! Adapted from Hal Levison's Swift routines symba5_merge.f and discard_mass_merge.f + implicit none + ! Arguments + class(collision_basic), intent(inout) :: self !! Merge fragment system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + + call self%merge(nbody_system, param, t) + + return + end subroutine collision_generate_basic + + + module subroutine collision_generate_bounce(self, nbody_system, param, t) + !! author: David A. Minton + !! + !! In this collision model, if the collision would result in a disruption, the bodies are instead "bounced" off + !! of the center of mass. This is done as a reflection in the 2-body equivalent distance vector direction. + implicit none + ! Arguments + class(collision_bounce), intent(inout) :: self !! Bounce fragment system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + ! Internals + integer(I4B) :: i,j,nfrag + real(DP), dimension(NDIM) :: vcom, rnorm + + select type(nbody_system) + class is (swiftest_nbody_system) + select type (pl => nbody_system%pl) + class is (swiftest_pl) + associate(impactors => nbody_system%collider%impactors, fragments => nbody_system%collider%fragments) + select case (impactors%regime) + case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + nfrag = size(impactors%id(:)) + do i = 1, nfrag + j = impactors%id(i) + vcom(:) = pl%vb(:,j) - impactors%vbcom(:) + rnorm(:) = .unit. (impactors%rb(:,2) - impactors%rb(:,1)) + ! Do the reflection + vcom(:) = vcom(:) - 2 * dot_product(vcom(:),rnorm(:)) * rnorm(:) + pl%vb(:,j) = impactors%vbcom(:) + vcom(:) + self%status = DISRUPTED + pl%status(j) = ACTIVE + pl%ldiscard(j) = .false. + pl%lcollision(j) = .false. + end do + select type(before => self%before) + class is (swiftest_nbody_system) + select type(after => self%after) + class is (swiftest_nbody_system) + allocate(after%pl, source=before%pl) ! Be sure to save the pl so that snapshots still work + end select + end select + case (COLLRESOLVE_REGIME_HIT_AND_RUN) + call self%hitandrun(nbody_system, param, t) + case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) + call self%merge(nbody_system, param, t) ! Use the default collision model, which is merge + case default + write(*,*) "Error in swiftest_collision, unrecognized collision regime" + call util_exit(FAILURE) + end select + end associate + end select + end select + + return + end subroutine collision_generate_bounce + + + module subroutine collision_generate_hitandrun(self, nbody_system, param, t) + !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Create the fragments resulting from a non-catastrophic hit-and-run collision + !! + implicit none + ! Arguments + class(collision_basic), intent(inout) :: self !! Collision system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + ! Result + integer(I4B) :: status !! Status flag assigned to this outcome + ! Internals + character(len=STRMAX) :: message + + + select type(nbody_system) + class is (swiftest_nbody_system) + select type(pl => nbody_system%pl) + class is (swiftest_pl) + associate(impactors => self%impactors) + message = "Hit and run between" + call collision_io_collider_message(nbody_system%pl, impactors%id, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, trim(adjustl(message))) + + status = HIT_AND_RUN_PURE + pl%status(impactors%id(:)) = ACTIVE + pl%ldiscard(impactors%id(:)) = .false. + pl%lcollision(impactors%id(:)) = .false. + ! Be sure to save the pl so that snapshots still work + select type(before => self%before) + class is (swiftest_nbody_system) + select type(after => self%after) + class is (swiftest_nbody_system) + allocate(after%pl, source=before%pl) + end select + end select + + end associate + end select + end select + + return + end subroutine collision_generate_hitandrun + + + module subroutine collision_generate_merge(self, nbody_system, param, t) + !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Merge massive bodies in any collisional system. + !! + !! Adapted from David E. Kaufmann's Swifter routines symba_merge_pl.f90 and symba_discard_merge_pl.f90 + !! + !! Adapted from Hal Levison's Swift routines symba5_merge.f and discard_mass_merge.f + implicit none + ! Arguments + class(collision_basic), intent(inout) :: self !! Merge fragment system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + ! Internals + integer(I4B) :: i, j, k, ibiggest + real(DP), dimension(NDIM) :: Lspin_new + real(DP) :: volume, G + character(len=STRMAX) :: message + + select type(nbody_system) + class is (swiftest_nbody_system) + associate(impactors => nbody_system%collider%impactors) + message = "Merging" + call collision_io_collider_message(nbody_system%pl, impactors%id, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) + + select type(pl => nbody_system%pl) + class is (swiftest_pl) + ! Get coordinate system + call impactors%set_coordinate_system() + + ! Generate the merged body as a single fragment + call self%setup_fragments(1) + associate(fragments => nbody_system%collider%fragments) + + ! Calculate the initial energy of the nbody_system without the collisional family + call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) + + ! The new body's metadata will be taken from the largest of the two impactor bodies, so we need + ! its index in the main pl structure + ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) + fragments%id(1) = pl%id(ibiggest) + allocate(fragments%info, source=pl%info(ibiggest:ibiggest)) + + ! Compute the physical properties of the new body after the merge. + volume = 4._DP / 3._DP * PI * sum(impactors%radius(:)**3) + G = nbody_system%collider%impactors%Gmass(1) / nbody_system%collider%impactors%mass(1) + fragments%mass(1) = impactors%mass_dist(1) + fragments%Gmass(1) = G * fragments%mass(1) + fragments%density(1) = fragments%mass(1) / volume + fragments%radius(1) = (3._DP * volume / (4._DP * PI))**(THIRD) + if (param%lrotation) then + do concurrent(i = 1:NDIM) + fragments%Ip(i,1) = sum(impactors%mass(:) * impactors%Ip(i,:)) + Lspin_new(i) = sum(impactors%Lorbit(i,:) + impactors%Lorbit(i,:)) + end do + fragments%Ip(:,1) = fragments%Ip(:,1) / fragments%mass(1) + fragments%rot(:,1) = Lspin_new(:) / (fragments%Ip(3,1) * fragments%mass(1) * fragments%radius(1)**2) + else ! If spin is not enabled, we will consider the lost pre-collision angular momentum as "escaped" and add it to our bookkeeping variable + nbody_system%Lescape(:) = nbody_system%Lescape(:) + impactors%Lorbit(:,1) + impactors%Lorbit(:,2) + end if + + ! The fragment trajectory will be the barycentric trajectory + fragments%rb(:,1) = impactors%rbcom(:) + fragments%vb(:,1) = impactors%vbcom(:) + fragments%rc(:,1) = 0.0_DP + fragments%vc(:,1) = 0.0_DP + + ! Get the energy of the system after the collision + call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) + + ! Update any encounter lists that have the removed bodies in them so that they instead point to the new body + do k = 1, nbody_system%plpl_encounter%nenc + do j = 1, impactors%ncoll + i = impactors%id(j) + if (i == ibiggest) cycle + if (nbody_system%plpl_encounter%id1(k) == pl%id(i)) then + nbody_system%plpl_encounter%id1(k) = pl%id(ibiggest) + nbody_system%plpl_encounter%index1(k) = i + end if + if (nbody_system%plpl_encounter%id2(k) == pl%id(i)) then + nbody_system%plpl_encounter%id2(k) = pl%id(ibiggest) + nbody_system%plpl_encounter%index2(k) = i + end if + if (nbody_system%plpl_encounter%id1(k) == nbody_system%plpl_encounter%id2(k)) nbody_system%plpl_encounter%status(k) = INACTIVE + end do + end do + + self%status = MERGED + + call collision_resolve_mergeaddsub(nbody_system, param, t, self%status) + + end associate + end select + end associate + end select + return + end subroutine collision_generate_merge + + +end submodule s_collision_generate diff --git a/src/collision/collision_io.f90 b/src/collision/collision_io.f90 new file mode 100644 index 000000000..a798004d1 --- /dev/null +++ b/src/collision/collision_io.f90 @@ -0,0 +1,349 @@ +!! 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. + +submodule(collision) s_collision_io + use swiftest + +contains + + module subroutine collision_io_collider_message(pl, collidx, collider_message) + !! author: David A. Minton + !! + !! Prints a nicely formatted message about which bodies collided, including their names and ids. + !! This subroutine appends the body names and ids to an input message. + implicit none + ! Arguments + class(base_object), intent(in) :: pl !! Swiftest massive body object + integer(I4B), dimension(:), intent(in) :: collidx !! Index of collisional colliders%idx members + character(*), intent(inout) :: collider_message !! The message to print to the screen. + ! Internals + integer(I4B) :: i, n + character(len=STRMAX) :: idstr + + + n = size(collidx) + if (n == 0) return + + select type(pl) + class is (swiftest_pl) + do i = 1, n + if (i > 1) collider_message = trim(adjustl(collider_message)) // " and " + collider_message = " " // trim(adjustl(collider_message)) // " " // trim(adjustl(pl%info(collidx(i))%name)) + write(idstr, '(I10)') pl%id(collidx(i)) + collider_message = trim(adjustl(collider_message)) // " (" // trim(adjustl(idstr)) // ") " + end do + + end select + + return + end subroutine collision_io_collider_message + + + module subroutine collision_io_log_regime(impactors) + !! author: David A. Minton + !! + !! Writes a log of the results of the collisional regime determination + implicit none + ! Arguments + class(collision_impactors), intent(inout) :: impactors !! Collision system object + ! Internals + character(STRMAX) :: errmsg + + open(unit=LUN, file=COLLISION_LOG_OUT, status = 'OLD', position = 'APPEND', form = 'FORMATTED', err = 667, iomsg = errmsg) + write(LUN, *, err = 667, iomsg = errmsg) + write(LUN, *) "--------------------------------------------------------------------" + write(LUN, *) " Collisional regime determination results" + write(LUN, *) "--------------------------------------------------------------------" + write(LUN, *) "True number of impactors : ",impactors%ncoll + write(LUN, *) "Index list of true impactors : ",impactors%id(1:impactors%ncoll) + select case(impactors%regime) + case(COLLRESOLVE_REGIME_MERGE) + write(LUN, *) "Regime: Merge" + case(COLLRESOLVE_REGIME_DISRUPTION) + write(LUN, *) "Regime: Disruption" + case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + write(LUN, *) "Regime: Supercatastrophic disruption" + case(COLLRESOLVE_REGIME_GRAZE_AND_MERGE) + write(LUN, *) "Regime: Graze and merge" + case(COLLRESOLVE_REGIME_HIT_AND_RUN) + write(LUN, *) "Regime: Hit and run" + end select + write(LUN, *) "Expected energy change : ", -impactors%Qloss + write(LUN, *) "--------------------------------------------------------------------" + close(LUN) + + return + 667 continue + write(*,*) "Error writing collision regime information to log file: " // trim(adjustl(errmsg)) + end subroutine collision_io_log_regime + + + module subroutine collision_io_netcdf_dump(self, param) + !! author: David A. Minton + !! + !! Dumps the time history of an encounter to file. + implicit none + ! Arguments + class(collision_storage(*)), intent(inout) :: self !! Encounter storage object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i + + select type(nc => self%nc) + class is (collision_netcdf_parameters) + select type(param) + class is (swiftest_parameters) + if (self%iframe > 0) then + nc%file_number = nc%file_number + 1 + call self%make_index_map() + nc%event_dimsize = self%nt + nc%name_dimsize = self%nid + + write(nc%file_name, '("collision_",I0.6,".nc")') nc%file_number + call nc%initialize(param) + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) then + select type(snapshot => self%frame(i)%item) + class is (collision_snapshot) + param%ioutput = i + call snapshot%write_frame(self,param) + end select + else + exit + end if + end do + + call nc%close() + call self%reset() + end if + end select + end select + + return + 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. + use, intrinsic :: ieee_arithmetic + use netcdf + implicit none + ! Arguments + class(collision_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(base_parameters), intent(in) :: param + ! Internals + integer(I4B) :: nvar, varid, vartype + real(DP) :: dfill + real(SP) :: sfill + integer(I4B), parameter :: NO_FILL = 0 + logical :: fileExists + character(len=STRMAX) :: errmsg + integer(I4B) :: ndims + + select type(param) + class is (base_parameters) + associate(nc => self) + dfill = ieee_value(dfill, IEEE_QUIET_NAN) + sfill = ieee_value(sfill, IEEE_QUIET_NAN) + + select case (param%out_type) + case("NETCDF_FLOAT") + self%out_type = NF90_FLOAT + case("NETCDF_DOUBLE") + self%out_type = NF90_DOUBLE + case default + write(*,*) trim(adjustl(param%out_type)), " is an invalid OUT_TYPE" + end select + + ! Check if the file exists, and if it does, delete it + inquire(file=nc%file_name, exist=fileExists) + if (fileExists) then + open(unit=LUN, file=nc%file_name, status="old", err=667, iomsg=errmsg) + 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" ) + nc%lfile_is_open = .true. + + ! Dimensions + call netcdf_io_check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "collision_io_netcdf_initialize_output nf90_def_dim event_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, nc%name_dimsize, 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" + + ! Dimension coordinates + 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" ) + + ! 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%time_dimname, nc%out_type, & + nc%event_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%event_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%event_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%event_dimid], nc%ptype_varid), "collision_io_netcdf_initialize_output nf90_def_var ptype_varid") + + call netcdf_io_check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & + [ nc%event_dimid], nc%loop_varid), "collision_io_netcdf_initialize_output nf90_def_var loop_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%event_dimid], nc%rh_varid), "collision_io_netcdf_initialize_output nf90_def_var rh_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%event_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%event_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%event_dimid], nc%radius_varid), "collision_io_netcdf_initialize_output nf90_def_var radius_varid") + + 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%event_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%event_dimid], nc%rot_varid), "collision_io_netcdf_initialize_output nf90_def_var rot_varid") + + if (param%lenergy) then + + call netcdf_io_check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& + [ nc%stage_dimid, nc%event_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%event_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%event_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%event_dimid], nc%BE_varid), "collision_io_netcdf_initialize_output nf90_def_var BE_varid" ) + + call netcdf_io_check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "collision_io_netcdf_initialize_output nf90_def_var L_orb_varid" ) + + call netcdf_io_check( nf90_def_var(nc%id, nc%Lspin_varname, nc%out_type,& + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%Lspin_varid), "collision_io_netcdf_initialize_output nf90_def_var Lspin_varid" ) + end if + + 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" ) + 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" ) + 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" ) + 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" ) + 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" ) + 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" ) + + ! 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" ) + + end associate + end select + + return + + 667 continue + write(*,*) "Error creating fragmentation output file. " // trim(adjustl(errmsg)) + call util_exit(FAILURE) + end subroutine collision_io_netcdf_initialize_output + + + module subroutine collision_io_netcdf_write_frame_snapshot(self, history, param) + !! author: David A. Minton + !! + !! Write a frame of output of a collision result + use netcdf + implicit none + ! Arguments + class(collision_snapshot), intent(in) :: self !! Swiftest encounter structure + 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 + character(len=:), allocatable :: charstring + class(swiftest_pl), allocatable :: pl + + select type(nc => history%nc) + class is (collision_netcdf_parameters) + associate(collider => self%collider, impactors => self%collider%impactors, fragments => self%collider%fragments, eslot => param%ioutput) + 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%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%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "collision_io_netcdf_write_frame_snapshot nf90_put_varloop_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=[len(charstring), 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) + select type(after =>self%collider%before) + class is (swiftest_nbody_system) + do stage = 1,2 + if (allocated(pl)) deallocate(pl) + select case(stage) + case(1) + allocate(pl, source=before%pl) + case(2) + allocate(pl, source=after%pl) + end select + npl = pl%nbody + do i = 1, npl + idslot = findloc(history%idvals,pl%id(i),dim=1) + 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=[len(charstring), 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=[len(charstring), 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" ) + 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), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var rotx_varid" ) + end do + 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%L_orb_varid, collider%Lorbit(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var L_orb_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Lspin_varid, collider%Lspin(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var Lspin_varid before" ) + end if + + call netcdf_io_check( nf90_set_fill(nc%id, old_mode, old_mode) ) + end associate + end select + return + end subroutine collision_io_netcdf_write_frame_snapshot + +end submodule s_collision_io \ No newline at end of file diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 new file mode 100644 index 000000000..3fa91a220 --- /dev/null +++ b/src/collision/collision_module.f90 @@ -0,0 +1,597 @@ +!! 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. + + +module collision + !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Definition of classes and methods used to determine close encounters + use globals + use base + use encounter + implicit none + public + + character(len=*), parameter :: COLLISION_LOG_OUT = "collision.log" !! Name of log file for collision diagnostic information + + !>Symbolic names for collisional outcomes from collresolve_resolve: + integer(I4B), parameter :: COLLRESOLVE_REGIME_MERGE = 1 + integer(I4B), parameter :: COLLRESOLVE_REGIME_DISRUPTION = 2 + integer(I4B), parameter :: COLLRESOLVE_REGIME_SUPERCATASTROPHIC = 3 + integer(I4B), parameter :: COLLRESOLVE_REGIME_GRAZE_AND_MERGE = 4 + integer(I4B), parameter :: COLLRESOLVE_REGIME_HIT_AND_RUN = 5 + character(len=*),dimension(5), parameter :: REGIME_NAMES = ["Merge", "Disruption", "Supercatastrophic", "Graze and Merge", "Hit and Run"] + + !> Swiftest class for tracking pl-pl close encounters in a step when collisions are possible + type, extends(encounter_list) :: collision_list_plpl + contains + procedure :: extract_collisions => collision_resolve_extract_plpl !! Processes the pl-pl encounter list remove only those encounters that led to a collision + procedure :: collision_check => collision_check_plpl !! Checks if a test particle is going to collide with a massive body + procedure :: resolve_collision => collision_resolve_plpl !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the collision + final :: collision_final_plpl + end type collision_list_plpl + + + !> Class for tracking pl-tp close encounters in a step when collisions are possible + type, extends(encounter_list) :: collision_list_pltp + contains + procedure :: extract_collisions => collision_resolve_extract_pltp !! Processes the pl-tp encounter list remove only those encounters that led to a collision + procedure :: collision_check => collision_check_pltp !! Checks if a test particle is going to collide with a massive body + procedure :: resolve_collision => collision_resolve_pltp !! Process the pl-tp collision list + final :: collision_final_pltp + end type collision_list_pltp + + + !> Class definition for the variables that describe the bodies involved in the collision + type, extends(base_object) :: collision_impactors + integer(I4B) :: ncoll !! Number of bodies involved in the collision + integer(I4B), dimension(:), allocatable :: id !! Index of bodies involved in the collision + real(DP), dimension(NDIM,2) :: rb !! Two-body equivalent position vectors of the collider bodies prior to collision in system barycentric coordinates + real(DP), dimension(NDIM,2) :: vb !! Two-body equivalent velocity vectors of the collider bodies prior to collision in system barycentric coordinate + real(DP), dimension(NDIM,2) :: rc !! Two-body equivalent position vectors of the collider bodies prior to collision in collision center of mass coordinates + real(DP), dimension(NDIM,2) :: vc !! Two-body equivalent velocity vectors of the collider bodies prior to collision in collision center of mass coordinates + real(DP), dimension(NDIM,2) :: rot !! Two-body equivalent principal axes moments of inertia the collider bodies prior to collision + real(DP), dimension(NDIM,2) :: Lspin !! Two-body equivalent spin angular momentum vectors of the collider bodies prior to collision + real(DP), dimension(NDIM,2) :: Lorbit !! Two-body equivalent orbital angular momentum vectors of the collider bodies prior to collision + real(DP), dimension(NDIM,2) :: Ip !! Two-body equivalent principal axes moments of inertia the collider bodies prior to collision + real(DP), dimension(2) :: Gmass !! Two-body equivalent G*mass of the collider bodies prior to the collision + real(DP), dimension(2) :: mass !! Two-body equivalent mass of the collider bodies prior to the collision + real(DP), dimension(2) :: radius !! Two-body equivalent radii of the collider bodies prior to the collision + real(DP) :: Qloss !! Energy lost during the collision + integer(I4B) :: regime !! Collresolve regime code for this collision + real(DP), dimension(:), allocatable :: mass_dist !! Distribution of fragment mass determined by the regime calculation (largest fragment, second largest, and remainder) + real(DP) :: Mcb !! Mass of central body (used to compute potential energy in regime determination) + + ! Values in a coordinate frame centered on the collider barycenter and collisional system unit vectors + real(DP), dimension(NDIM) :: x_unit !! x-direction unit vector of collisional system + real(DP), dimension(NDIM) :: y_unit !! y-direction unit vector of collisional system + real(DP), dimension(NDIM) :: z_unit !! z-direction unit vector of collisional system + real(DP), dimension(NDIM) :: v_unit !! velocity direction unit vector of collisional system + real(DP), dimension(NDIM) :: rbcom !! Center of mass position vector of the collider nbody_system in nbody_system barycentric coordinates + real(DP), dimension(NDIM) :: vbcom !! Velocity vector of the center of mass of the collider nbody_system in nbody_system barycentric coordinates + real(DP), dimension(NDIM) :: rbimp !! Impact point position vector of the collider nbody_system in nbody_system barycentric coordinates + real(DP), dimension(NDIM) :: bounce_unit !! The impact point velocity vector is the component of the velocity in the distance vector direction + + contains + procedure :: consolidate => collision_resolve_consolidate_impactors !! Consolidates a multi-body collision into an equivalent 2-body collision + procedure :: get_regime => collision_regime_impactors !! Determine which fragmentation regime the set of impactors will be + procedure :: reset => collision_util_reset_impactors !! Resets the collider object variables to 0 and deallocates the index and mass distributions + procedure :: set_coordinate_system => collision_util_set_coordinate_impactors !! Sets the coordinate system of the impactors + final :: collision_final_impactors !! Finalizer will deallocate all allocatables + end type collision_impactors + + + !> Class definition for the variables that describe a collection of fragments in barycentric coordinates + type, extends(base_multibody) :: collision_fragments + real(DP) :: mtot !! Total mass of fragments + class(base_particle_info), dimension(:), allocatable :: info !! Particle metadata information + integer(I4B), dimension(nbody) :: status !! An integrator-specific status indicator + real(DP), dimension(NDIM,nbody) :: rh !! Heliocentric position + real(DP), dimension(NDIM,nbody) :: vh !! Heliocentric velocity + real(DP), dimension(NDIM,nbody) :: rb !! Barycentric position + real(DP), dimension(NDIM,nbody) :: vb !! Barycentric velocity + real(DP), dimension(NDIM,nbody) :: rot !! rotation vectors of fragments + real(DP), dimension(NDIM,nbody) :: Ip !! Principal axes moment of inertia for fragments + real(DP), dimension(nbody) :: Gmass !! G*mass of fragments + real(DP), dimension(nbody) :: mass !! masses of fragments + real(DP), dimension(nbody) :: radius !! Radii of fragments + real(DP), dimension(nbody) :: density !! Radii of fragments + real(DP), dimension(NDIM,nbody) :: rc !! Position vectors in the collision coordinate frame + real(DP), dimension(NDIM,nbody) :: vc !! Velocity vectors in the collision coordinate frame + real(DP), dimension(nbody) :: rmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame + real(DP), dimension(nbody) :: vmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame + real(DP), dimension(nbody) :: rotmag !! Array of rotation magnitudes of individual fragments + real(DP), dimension(NDIM,nbody) :: r_unit !! Array of radial direction unit vectors of individual fragments in the collisional coordinate frame + real(DP), dimension(NDIM,nbody) :: v_unit !! Array of velocity direction unit vectors of individual fragments in the collisional coordinate frame + real(DP), dimension(NDIM,nbody) :: t_unit !! Array of tangential direction unit vectors of individual fragments in the collisional coordinate frame + real(DP), dimension(NDIM,nbody) :: n_unit !! Array of normal direction unit vectors of individual fragments in the collisional coordinate frame + integer(I1B), dimension(nbody) :: origin_body !! Array of indices indicating which impactor body (1 or 2) the fragment originates from + real(DP), dimension(NDIM) :: Lorbit_tot !! Orbital angular momentum vector of all fragments + real(DP), dimension(NDIM) :: Lspin_tot !! Spin angular momentum vector of all fragments + real(DP), dimension(NDIM,nbody) :: Lorbit !! Orbital angular momentum vector of each individual fragment + real(DP), dimension(NDIM,nbody) :: Lspin !! Spin angular momentum vector of each individual fragment + real(DP) :: ke_orbit_tot !! Orbital kinetic energy of all fragments + real(DP) :: ke_spin_tot !! Spin kinetic energy of all fragments + real(DP) :: pe !! Potential energy of all fragments + real(DP) :: be !! Binding energy of all fragments + real(DP) :: E_budget !! Kinetic energy budget for computing fragment trajectories + real(DP), dimension(NDIM) :: L_budget !! Angular momentum budget for computing fragment trajectories + real(DP), dimension(nbody) :: ke_orbit !! Orbital kinetic energy of each individual fragment + real(DP), dimension(nbody) :: ke_spin !! Spin kinetic energy of each individual fragment + contains + procedure :: reset => collision_util_reset_fragments !! Deallocates all allocatable arrays and sets everything else to 0 + procedure :: get_angular_momentum => collision_util_get_angular_momentum !! Calcualtes the current angular momentum of the fragments + procedure :: get_energy => collision_util_get_energy !! Calcualtes the current kinetic energy of the fragments + procedure :: set_coordinate_system => collision_util_set_coordinate_fragments !! Sets the coordinate system of the fragments + final :: collision_final_fragments !! Finalizer deallocates all allocatables + end type collision_fragments + + + type :: collision_basic + !! This class defines a collisional system that stores impactors and fragments. This is written so that various collision models (i.e. Fraggle) could potentially be used + !! to resolve collision by defining extended types of encounters_impactors and/or encounetr_fragments + !! + !! The generate method for this class is the merge model. This allows any extended type to have access to the merge procedure by selecting the collision_basic parent class + class(collision_fragments(:)), allocatable :: fragments !! Object containing information on the pre-collision system + class(collision_impactors), allocatable :: impactors !! Object containing information on the post-collision system + class(base_nbody_system), allocatable :: before !! A snapshot of the subset of the nbody_system involved in the collision + class(base_nbody_system), allocatable :: after !! A snapshot of the subset of the nbody_system containing products of the collision + integer(I4B) :: status !! Status flag to pass to the collision list once the collision has been resolved + + ! For the following variables, index 1 refers to the *entire* n-body nbody_system in its pre-collisional state and index 2 refers to the nbody_system in its post-collisional state + real(DP), dimension(NDIM,2) :: Lorbit !! Before/after orbital angular momentum + real(DP), dimension(NDIM,2) :: Lspin !! Before/after spin angular momentum + real(DP), dimension(NDIM,2) :: Ltot !! Before/after total nbody_system angular momentum + real(DP), dimension(2) :: ke_orbit !! Before/after orbital kinetic energy + real(DP), dimension(2) :: ke_spin !! Before/after spin kinetic energy + real(DP), dimension(2) :: pe !! Before/after potential energy + real(DP), dimension(2) :: be !! Before/after binding energy + real(DP), dimension(2) :: Etot !! Before/after total nbody_system energy + contains + procedure :: setup => collision_util_setup_collider !! Initializer for the encounter collision system and the before/after snapshots + procedure :: setup_impactors => collision_util_setup_impactors_collider !! Initializer for the impactors for the encounter collision system. Deallocates old impactors before creating new ones + procedure :: setup_fragments => collision_util_setup_fragments_collider !! Initializer for the fragments of the collision system. + procedure :: add_fragments => collision_util_add_fragments_to_collider !! Add fragments to nbody_system + procedure :: construct_temporary_system => collision_util_construct_temporary_system !! Constructs temporary n-body nbody_system in order to compute pre- and post-impact energy and momentum + procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total nbody_system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) + procedure :: reset => collision_util_reset_system !! Deallocates all allocatables + procedure :: set_budgets => collision_util_set_budgets !! Sets the energy and momentum budgets of the fragments based on the collider value + procedure :: set_coordinate_system => collision_util_set_coordinate_collider !! Sets the coordinate system of the collisional system + procedure :: generate => collision_generate_basic !! Merges the impactors to make a single final body + procedure :: hitandrun => collision_generate_hitandrun !! Merges the impactors to make a single final body + procedure :: merge => collision_generate_merge !! Merges the impactors to make a single final body + end type collision_basic + + type, extends(collision_basic) :: collision_bounce + contains + procedure :: generate => collision_generate_bounce !! If a collision would result in a disruption, "bounce" the bodies instead. + final :: collision_final_bounce !! Finalizer will deallocate all allocatables + end type collision_bounce + + + + + !! NetCDF dimension and variable names for the enounter save object + type, extends(encounter_netcdf_parameters) :: collision_netcdf_parameters + integer(I4B) :: stage_dimid !! ID for the stage dimension + integer(I4B) :: stage_varid !! ID for the stage variable + character(NAMELEN) :: stage_dimname = "stage" !! name of the stage dimension (before/after) + character(len=6), dimension(2) :: stage_coords = ["before", "after"] !! The stage coordinate labels + + character(NAMELEN) :: event_dimname = "collision" !! Name of collision event dimension + integer(I4B) :: event_dimid !! ID for the collision event dimension + integer(I4B) :: event_varid !! ID for the collision event variable + integer(I4B) :: event_dimsize = 0 !! Number of events + + character(NAMELEN) :: Qloss_varname = "Qloss" !! name of the energy loss variable + integer(I4B) :: Qloss_varid !! ID for the energy loss variable + character(NAMELEN) :: regime_varname = "regime" !! name of the collision regime variable + integer(I4B) :: regime_varid !! ID for the collision regime variable + contains + procedure :: initialize => collision_io_netcdf_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object + final :: collision_final_netcdf_parameters !! Finalizer closes the NetCDF file + end type collision_netcdf_parameters + + + type, extends(encounter_snapshot) :: collision_snapshot + logical :: lcollision !! Indicates that this snapshot contains at least one collision + class(collision_basic), allocatable :: collider !! Collider object at this snapshot + contains + procedure :: write_frame => collision_io_netcdf_write_frame_snapshot !! Writes a frame of encounter data to file + procedure :: get_idvals => collision_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot + final :: collision_final_snapshot !! Finalizer deallocates all allocatables + end type collision_snapshot + + + !> A class that that is used to store simulation history data between file output + type, extends(encounter_storage) :: collision_storage + contains + procedure :: dump => collision_io_netcdf_dump !! Dumps contents of encounter history to file + procedure :: take_snapshot => collision_util_snapshot !! Take a minimal snapshot of the nbody_system through an encounter + procedure :: make_index_map => collision_util_index_map !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + final :: collision_final_storage !! Finalizer deallocates all allocatables + end type collision_storage + + + interface + module subroutine collision_generate_basic(self, nbody_system, param, t) + implicit none + class(collision_basic), intent(inout) :: self !! Merge fragment nbody_system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + end subroutine collision_generate_basic + + module subroutine collision_generate_bounce(self, nbody_system, param, t) + implicit none + class(collision_bounce), intent(inout) :: self !! Bounce fragment nbody_system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + end subroutine collision_generate_bounce + + module subroutine collision_generate_hitandrun(self, nbody_system, param, t) + implicit none + class(collision_basic), intent(inout) :: self + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + end subroutine collision_generate_hitandrun + + module subroutine collision_generate_merge(self, nbody_system, param, t) + implicit none + class(collision_basic), intent(inout) :: self !! Merge fragment nbody_system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + end subroutine collision_generate_merge + + module subroutine collision_io_collider_message(pl, collidx, collider_message) + implicit none + class(base_object), intent(in) :: pl !! Swiftest massive body object + integer(I4B), dimension(:), intent(in) :: collidx !! Index of collisional colliders%idx members + character(*), intent(inout) :: collider_message !! The message to print to the screen. + end subroutine collision_io_collider_message + + module subroutine collision_io_log_regime(impactors) + implicit none + class(collision_impactors), intent(inout) :: impactors !! Collision system object + end subroutine collision_io_log_regime + + module subroutine collision_io_netcdf_dump(self, param) + implicit none + class(collision_storage(*)), intent(inout) :: self !! Collision storage object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine collision_io_netcdf_dump + + module subroutine collision_io_netcdf_initialize_output(self, param) + implicit none + class(collision_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(base_parameters), intent(in) :: param !! Current run configuration parameters + end subroutine collision_io_netcdf_initialize_output + + module subroutine collision_io_netcdf_write_frame_snapshot(self, history, param) + implicit none + class(collision_snapshot), intent(in) :: self !! Swiftest encounter structure + class(encounter_storage(*)), intent(inout) :: history !! Collision history object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine collision_io_netcdf_write_frame_snapshot + + module subroutine collision_regime_impactors(self, nbody_system, param) + implicit none + class(collision_impactors), intent(inout) :: self !! Collision system impactors object + class(base_nbody_system), intent(in) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + end subroutine collision_regime_impactors + + module subroutine collision_check_plpl(self, nbody_system, param, t, dt, irec, lany_collision) + implicit none + class(collision_list_plpl), intent(inout) :: self !! encounter list object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest 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 any pair of encounters resulted in a collision + end subroutine collision_check_plpl + + module subroutine collision_check_pltp(self, nbody_system, param, t, dt, irec, lany_collision) + implicit none + class(collision_list_pltp), intent(inout) :: self !! encounter list object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest 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 any pair of encounters resulted in a collision + end subroutine collision_check_pltp + + module subroutine collision_resolve_consolidate_impactors(self, nbody_system, param, idx_parent, lflag) + implicit none + 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 + end subroutine collision_resolve_consolidate_impactors + + module subroutine collision_resolve_extract_plpl(self, nbody_system, param) + implicit none + class(collision_list_plpl), intent(inout) :: self !! pl-pl encounter list + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current run configuration parameters + end subroutine collision_resolve_extract_plpl + + module subroutine collision_resolve_extract_pltp(self, nbody_system, param) + implicit none + 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 + end subroutine collision_resolve_extract_pltp + + module subroutine collision_resolve_make_impactors_pl(pl, idx) + implicit none + class(base_object), intent(inout) :: pl !! Massive body object + integer(I4B), dimension(:), intent(in) :: idx !! Array holding the indices of the two bodies involved in the collision + end subroutine collision_resolve_make_impactors_pl + + module subroutine collision_resolve_mergeaddsub(nbody_system, param, t, status) + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions + real(DP), intent(in) :: t !! Time of collision + integer(I4B), intent(in) :: status !! Status flag to assign to adds + end subroutine collision_resolve_mergeaddsub + + module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) + implicit none + class(collision_list_plpl), intent(inout) :: self !! pl-pl encounter list + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions + real(DP), intent(in) :: t !! Current simulation time + real(DP), intent(in) :: dt !! Current simulation step size + integer(I4B), intent(in) :: irec !! Current recursion level + end subroutine collision_resolve_plpl + + module subroutine collision_resolve_pltp(self, nbody_system, param, t, dt, irec) + implicit none + 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(inout) :: param !! Current run configuration parameters with Swiftest additions + real(DP), intent(in) :: t !! Current simulation time + real(DP), intent(in) :: dt !! Current simulation step size + integer(I4B), intent(in) :: irec !! Current recursion level + end subroutine collision_resolve_pltp + + module subroutine collision_util_add_fragments_to_collider(self, nbody_system, param) + implicit none + class(collision_basic), intent(in) :: self !! Collision system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters + end subroutine collision_util_add_fragments_to_collider + + module subroutine collision_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) + implicit none + class(collision_basic), intent(inout) :: self !! Collision system object + class(base_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(base_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object + class(base_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters + end subroutine collision_util_construct_temporary_system + + module subroutine collision_util_get_angular_momentum(self) + implicit none + class(collision_fragments(*)), intent(inout) :: self !! Fragment system object + end subroutine collision_util_get_angular_momentum + + module subroutine collision_util_get_energy(self) + implicit none + class(collision_fragments(*)), intent(inout) :: self !! Fragment system object + end subroutine collision_util_get_energy + + module subroutine collision_util_reset_fragments(self) + implicit none + class(collision_fragments(*)), intent(inout) :: self + end subroutine collision_util_reset_fragments + + module subroutine collision_util_set_budgets(self) + implicit none + class(collision_basic), intent(inout) :: self !! Collision system object + end subroutine collision_util_set_budgets + + module subroutine collision_util_set_coordinate_collider(self) + implicit none + class(collision_basic), intent(inout) :: self !! collisional system + end subroutine collision_util_set_coordinate_collider + + module subroutine collision_util_set_coordinate_fragments(self) + implicit none + class(collision_fragments(*)), intent(inout) :: self !! Collisional nbody_system + end subroutine collision_util_set_coordinate_fragments + + module subroutine collision_util_set_coordinate_impactors(self) + implicit none + class(collision_impactors), intent(inout) :: self !! collisional system + end subroutine collision_util_set_coordinate_impactors + + module subroutine collision_util_setup_collider(self, nbody_system) + implicit none + class(collision_basic), intent(inout) :: self !! Encounter collision system object + class(base_nbody_system), intent(in) :: nbody_system !! Current nbody system. Used as a mold for the before/after snapshots + end subroutine collision_util_setup_collider + + module subroutine collision_util_setup_impactors_collider(self) + implicit none + class(collision_basic), intent(inout) :: self !! Encounter collision system object + end subroutine collision_util_setup_impactors_collider + + module subroutine collision_util_setup_fragments_collider(self, nfrag) + implicit none + class(collision_basic), intent(inout) :: self !! Encounter collision system object + integer(I4B), intent(in) :: nfrag !! Number of fragments to create + end subroutine collision_util_setup_fragments_collider + + module subroutine collision_util_shift_vector_to_origin(m_frag, vec_frag) + implicit none + real(DP), dimension(:), intent(in) :: m_frag !! Fragment masses + real(DP), dimension(:,:), intent(inout) :: vec_frag !! Fragment positions or velocities in the center of mass frame + end subroutine + + module subroutine collision_util_get_idvalues_snapshot(self, idvals) + implicit none + class(collision_snapshot), intent(in) :: self !! Collision snapshot object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot + end subroutine collision_util_get_idvalues_snapshot + + module subroutine collision_util_get_energy_momentum(self, nbody_system, param, lbefore) + use base, only : base_nbody_system, base_parameters + implicit none + class(collision_basic), intent(inout) :: self !! Encounter collision system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current swiftest run configuration parameters + logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the nbody_system, with impactors included and fragments excluded or vice versa + end subroutine collision_util_get_energy_momentum + + module subroutine collision_util_index_map(self) + implicit none + class(collision_storage(*)), intent(inout) :: self !! Collision storage object + end subroutine collision_util_index_map + + module subroutine collision_util_reset_impactors(self) + implicit none + class(collision_impactors), intent(inout) :: self !! Collision system object + end subroutine collision_util_reset_impactors + + module subroutine collision_util_reset_system(self) + implicit none + class(collision_basic), intent(inout) :: self !! Collision system object + end subroutine collision_util_reset_system + + module subroutine collision_util_snapshot(self, param, nbody_system, t, arg) + implicit none + class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + class(base_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 !! "before": takes a snapshot just before the collision. "after" takes the snapshot just after the collision. + end subroutine collision_util_snapshot + end interface + + contains + + subroutine collision_final_fragments(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_fragments(*)), intent(inout) :: self + + if (allocated(self%info)) deallocate(self%info) + return + end subroutine collision_final_fragments + + subroutine collision_final_impactors(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_impactors), intent(inout) :: self !! Collision impactors storage object + + call self%reset() + + return + end subroutine collision_final_impactors + + subroutine collision_final_netcdf_parameters(self) + !! author: David A. Minton + !! + !! Finalize the NetCDF by closing the file + implicit none + ! Arguments + type(collision_netcdf_parameters), intent(inout) :: self + + call self%close() + + return + end subroutine collision_final_netcdf_parameters + + subroutine collision_final_plpl(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_list_plpl), intent(inout) :: self !! PL-PL collision list object + + call self%dealloc() + + return + end subroutine collision_final_plpl + + subroutine collision_final_pltp(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_list_pltp), intent(inout) :: self !! PL-TP collision list object + + call self%dealloc() + + return + end subroutine collision_final_pltp + + subroutine collision_final_snapshot(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_snapshot), intent(inout) :: self !! Collsion snapshot object + + call encounter_final_snapshot(self%encounter_snapshot) + + return + end subroutine collision_final_snapshot + + subroutine collision_final_storage(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_storage(*)), intent(inout) :: self !! Collision storage object + ! Internals + integer(I4B) :: i + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) + end do + + return + end subroutine collision_final_storage + + subroutine collision_final_bounce(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_bounce), intent(inout) :: self !! Collision system object + + call self%reset() + if (allocated(self%impactors)) deallocate(self%impactors) + if (allocated(self%fragments)) deallocate(self%fragments) + + return + end subroutine collision_final_bounce + +end module collision + diff --git a/src/fraggle/fraggle_regime.f90 b/src/collision/collision_regime.f90 similarity index 73% rename from src/fraggle/fraggle_regime.f90 rename to src/collision/collision_regime.f90 index cf8d5891c..a1ae47fe0 100644 --- a/src/fraggle/fraggle_regime.f90 +++ b/src/collision/collision_regime.f90 @@ -7,83 +7,111 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(fraggle_classes) s_fraggle_regime +submodule(collision) s_collision_regime use swiftest contains - module subroutine fraggle_regime_colliders(self, frag, system, param) + + module subroutine collision_regime_impactors(self, nbody_system, param) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! - !! Determine which fragmentation regime the set of colliders will be. This subroutine is a wrapper for the non-polymorphic raggle_regime_collresolve subroutine. + !! Determine which fragmentation regime the set of impactors will be. This subroutine is a wrapper for the non-polymorphic raggle_regime_collresolve subroutine. !! It converts to SI units prior to calling implicit none ! Arguments - class(fraggle_colliders), intent(inout) :: self !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragment system object - class(swiftest_nbody_system), intent(in) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + class(collision_impactors), intent(inout) :: self !! Collision system impactors object + class(base_nbody_system), intent(in) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters ! Internals - integer(I4B) :: jtarg, jproj - real(DP), dimension(2) :: radius_si, mass_si, density_si - real(DP) :: min_mfrag_si, Mcb_si - real(DP), dimension(NDIM) :: x1_si, v1_si, x2_si, v2_si - real(DP) :: mlr, mslr, mtot, dentot + real (DP) :: mtot - associate(colliders => self) - ! Convert all quantities to SI units and determine which of the pair is the projectile vs. target before sending them to the regime determination subroutine - if (colliders%mass(1) > colliders%mass(2)) then - jtarg = 1 - jproj = 2 - else - jtarg = 2 - jproj = 1 - end if - mass_si(:) = colliders%mass([jtarg, jproj]) * param%MU2KG !! The two-body equivalent masses of the collider system - radius_si(:) = colliders%radius([jtarg, jproj]) * param%DU2M !! The two-body equivalent radii of the collider system - density_si(:) = mass_si(:) / (4.0_DP / 3._DP * PI * radius_si(:)**3) !! The two-body equivalent density of the collider system - x1_si(:) = colliders%xb(:,jtarg) * param%DU2M !! The first body of the two-body equivalent position vector the collider system - v1_si(:) = colliders%vb(:,jtarg) * param%DU2M / param%TU2S !! The first body of the two-body equivalent velocity vector the collider system - x2_si(:) = colliders%xb(:,jproj) * param%DU2M !! The second body of the two-body equivalent position vector the collider system - v2_si(:) = colliders%vb(:,jproj) * param%DU2M / param%TU2S !! The second body of the two-body equivalent velocity vector the collider system - Mcb_si = system%cb%mass * param%MU2KG !! The central body mass of the system - select type(param) - class is (symba_parameters) - min_mfrag_si = (param%min_GMfrag / param%GU) * param%MU2KG !! The minimum fragment mass to generate. Collider systems that would otherwise generate less massive fragments than this value will be forced to merge instead - class default - min_mfrag_si = 0.0_DP + associate(impactors => self) + select type (nbody_system) + class is (swiftest_nbody_system) + select type(param) + class is (swiftest_parameters) + + select case(param%collision_model) + case("MERGE") + impactors%regime = COLLRESOLVE_REGIME_MERGE + if (allocated(impactors%mass_dist)) deallocate(impactors%mass_dist) + allocate(impactors%mass_dist(1)) + impactors%mass_dist(1) = mtot + case default + call collision_regime_LS12(impactors, nbody_system, param) + call collision_io_log_regime(self) end select - - mtot = sum(mass_si(:)) - dentot = sum(mass_si(:) * density_si(:)) / mtot - - !! Use the positions and velocities of the parents from indside the step (at collision) to calculate the collisional regime - call fraggle_regime_collresolve(Mcb_si, mass_si(jtarg), mass_si(jproj), radius_si(jtarg), radius_si(jproj), & - x1_si(:), x2_si(:), v1_si(:), v2_si(:), density_si(jtarg), density_si(jproj), & - min_mfrag_si, frag%regime, mlr, mslr, frag%Qloss) + end select + end select + end associate - frag%mass_dist(1) = min(max(mlr, 0.0_DP), mtot) - frag%mass_dist(2) = min(max(mslr, 0.0_DP), mtot) - frag%mass_dist(3) = min(max(mtot - mlr - mslr, 0.0_DP), mtot) + return + end subroutine collision_regime_impactors - ! Find the center of mass of the collisional system - frag%mtot = sum(colliders%mass(:)) - frag%xbcom(:) = (colliders%mass(1) * colliders%xb(:,1) + colliders%mass(2) * colliders%xb(:,2)) / frag%mtot - frag%vbcom(:) = (colliders%mass(1) * colliders%vb(:,1) + colliders%mass(2) * colliders%vb(:,2)) / frag%mtot - ! Convert quantities back to the system units and save them into the fragment system - frag%mass_dist(:) = (frag%mass_dist(:) / param%MU2KG) - frag%Qloss = frag%Qloss * (param%TU2S / param%DU2M)**2 / param%MU2KG + subroutine collision_regime_LS12(impactors, nbody_system, param) + !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Determine the collisional regime of two colliding bodies based on the model by Leinhard and Stewart (2012) + !! + !! This is a wrapper subroutine that converts quantities to SI units and calls the main LS12 subroutine + implicit none + ! Arguments + class(collision_impactors), intent(inout) :: impactors !! The impactors to determine the regime for + class(swiftest_nbody_system), intent(in) :: nbody_system !! Swiftest n-body system object + class(swiftest_parameters), intent(in) :: param !! The current parameters + ! Internals + integer(I4B) :: jtarg, jproj + real(DP), dimension(2) :: radius_si, mass_si, density_si + real(DP) :: min_mfrag_si, Mcb_si + real(DP), dimension(NDIM) :: x1_si, v1_si, x2_si, v2_si, runit + real(DP) :: mlr, mslr, mtot, dentot + integer(I4B), parameter :: NMASS_DIST = 3 !! Number of mass bins returned by the regime calculation (largest fragment, second largest, and remainder) - call fraggle_io_log_regime(colliders, frag) - end associate + ! Convert all quantities to SI units and determine which of the pair is the projectile vs. target before sending them to the regime determination subroutine + if (impactors%mass(1) > impactors%mass(2)) then + jtarg = 1 + jproj = 2 + else + jtarg = 2 + jproj = 1 + end if + mass_si(:) = impactors%mass([jtarg, jproj]) * param%MU2KG !! The two-body equivalent masses of the collider system + radius_si(:) = impactors%radius([jtarg, jproj]) * param%DU2M !! The two-body equivalent radii of the collider system + density_si(:) = mass_si(:) / (4.0_DP / 3._DP * PI * radius_si(:)**3) !! The two-body equivalent density of the collider system + x1_si(:) = impactors%rb(:,jtarg) * param%DU2M !! The first body of the two-body equivalent position vector the collider system + v1_si(:) = impactors%vb(:,jtarg) * param%DU2M / param%TU2S !! The first body of the two-body equivalent velocity vector the collider system + x2_si(:) = impactors%rb(:,jproj) * param%DU2M !! The second body of the two-body equivalent position vector the collider system + v2_si(:) = impactors%vb(:,jproj) * param%DU2M / param%TU2S !! The second body of the two-body equivalent velocity vector the collider system + Mcb_si = nbody_system%cb%mass * param%MU2KG !! The central body mass of the system + min_mfrag_si = (param%min_GMfrag / param%GU) * param%MU2KG !! The minimum fragment mass to generate. Collider systems that would otherwise generate less massive fragments than this value will be forced to merge instead + + mtot = sum(mass_si(:)) + dentot = sum(mass_si(:) * density_si(:)) / mtot + + !! Use the positions and velocities of the parents from indside the step (at collision) to calculate the collisional regime + call collision_regime_LS12_SI(Mcb_si, mass_si(jtarg), mass_si(jproj), radius_si(jtarg), radius_si(jproj), & + x1_si(:), x2_si(:), v1_si(:), v2_si(:), density_si(jtarg), density_si(jproj), & + min_mfrag_si, impactors%regime, mlr, mslr, impactors%Qloss) + + if (allocated(impactors%mass_dist)) deallocate(impactors%mass_dist) + allocate(impactors%mass_dist(NMASS_DIST)) + impactors%mass_dist(1) = min(max(mlr, 0.0_DP), mtot) + impactors%mass_dist(2) = min(max(mslr, 0.0_DP), mtot) + impactors%mass_dist(3) = min(max(mtot - mlr - mslr, 0.0_DP), mtot) + + + ! Convert quantities back to the system units and save them into the fragment system + impactors%mass_dist(:) = (impactors%mass_dist(:) / param%MU2KG) + impactors%Qloss = impactors%Qloss * (param%TU2S / param%DU2M)**2 / param%MU2KG return - end subroutine fraggle_regime_colliders - + end subroutine collision_regime_LS12 + - subroutine fraggle_regime_collresolve(Mcb, m1, m2, rad1, rad2, xh1, xh2, vb1, vb2, den1, den2, min_mfrag, & - regime, Mlr, Mslr, Qloss) + subroutine collision_regime_LS12_SI(Mcb, m1, m2, rad1, rad2, rh1, rh2, vb1, vb2, den1, den2, min_mfrag, & + regime, Mlr, Mslr, Qloss) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Determine the collisional regime of two colliding bodies. @@ -103,7 +131,7 @@ subroutine fraggle_regime_collresolve(Mcb, m1, m2, rad1, rad2, xh1, xh2, vb1, vb implicit none ! Arguments real(DP), intent(in) :: Mcb, m1, m2, rad1, rad2, den1, den2, min_mfrag - real(DP), dimension(:), intent(in) :: xh1, xh2, vb1, vb2 + real(DP), dimension(:), intent(in) :: rh1, rh2, vb1, vb2 integer(I4B), intent(out) :: regime real(DP), intent(out) :: Mlr, Mslr real(DP), intent(out) :: Qloss !! The residual energy after the collision @@ -130,9 +158,9 @@ subroutine fraggle_regime_collresolve(Mcb, m1, m2, rad1, rad2, xh1, xh2, vb1, vb real(DP) :: U_binding Vimp = norm2(vb2(:) - vb1(:)) - b = calc_b(xh2, vb2, xh1, vb1) + b = calc_b(rh2, vb2, rh1, vb1) l = (rad1 + rad2) * (1 - b) - egy = 0.5_DP * dot_product(vb1, vb1) - GC * Mcb / norm2(xh1) + egy = 0.5_DP * dot_product(vb1, vb1) - GC * Mcb / norm2(rh1) a1 = - GC * Mcb / 2.0_DP / egy Mtot = m1 + m2 mu = (m1 * m2) / Mtot @@ -192,7 +220,7 @@ subroutine fraggle_regime_collresolve(Mcb, m1, m2, rad1, rad2, xh1, xh2, vb1, vb Mlr = Mtot Mslr = 0.0_DP Qloss = 0.0_DP - call io_log_one_message(FRAGGLE_LOG_OUT, & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, & "Fragments would have mass below the minimum. Converting this collision into a merger.") else if( Vimp < Vescp) then @@ -251,8 +279,8 @@ subroutine fraggle_regime_collresolve(Mcb, m1, m2, rad1, rad2, xh1, xh2, vb1, vb return - ! Internal functions contains + function calc_Qrd_pstar(Mtarg, Mp, alpha, c_star) result(Qrd_pstar) !! author: Jennifer L.L. Pouplin and Carlisle A. Wishard !! @@ -374,6 +402,8 @@ function calc_c_star(Rc1) result(c_star) return end function calc_c_star - end subroutine fraggle_regime_collresolve + end subroutine collision_regime_LS12_SI + + -end submodule s_fraggle_regime \ No newline at end of file +end submodule s_collision_regime \ No newline at end of file diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 new file mode 100644 index 000000000..0036a8a00 --- /dev/null +++ b/src/collision/collision_resolve.f90 @@ -0,0 +1,633 @@ +!! 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. + +submodule (collision) s_collision_resolve + 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, Lspin, 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 + ! Internals + type collidx_array + integer(I4B), dimension(:), allocatable :: id + integer(I4B), dimension(:), allocatable :: idx + end type collidx_array + type(collidx_array), dimension(2) :: parent_child_index_array + integer(I4B), dimension(2) :: nchild + integer(I4B) :: i, j, nimpactors, idx_child + real(DP), dimension(2) :: volume, density + real(DP) :: mchild, volchild + real(DP), dimension(NDIM) :: xc, vc, xcom, vcom, xchild, vchild, xcrossv + real(DP), dimension(NDIM,2) :: mxc, vcc + + select type(nbody_system) + class is (swiftest_nbody_system) + associate(impactors => self, pl => nbody_system%pl, cb => nbody_system%cb) + + nchild(:) = pl%kin(idx_parent(:))%nchild + ! 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) + lflag = .false. + call pl%reset_kinship([idx_parent(1)]) + return + end if + idx_parent(2) = pl%kin(idx_parent(1))%child(nchild(1)) + nchild(1) = nchild(1) - 1 + nchild(2) = 0 + pl%kin(idx_parent(:))%nchild = nchild(:) + pl%kin(idx_parent(2))%parent = idx_parent(1) + end if + + impactors%Gmass(:) = pl%Gmass(idx_parent(:)) + impactors%mass(:) = pl%mass(idx_parent(:)) + impactors%radius(:) = pl%radius(idx_parent(:)) + volume(:) = (4.0_DP / 3.0_DP) * PI * impactors%radius(:)**3 + + ! Group together the ids and indexes of each collisional parent and its children + do j = 1, 2 + allocate(parent_child_index_array(j)%idx(nchild(j)+ 1)) + allocate(parent_child_index_array(j)%id(nchild(j)+ 1)) + associate(idx_arr => parent_child_index_array(j)%idx, & + id_arr => parent_child_index_array(j)%id, & + ncj => nchild(j), & + plkinj => pl%kin(idx_parent(j))) + idx_arr(1) = idx_parent(j) + if (ncj > 0) idx_arr(2:ncj + 1) = plkinj%child(1:ncj) + id_arr(:) = pl%id(idx_arr(:)) + end associate + end do + + ! Consolidate the groups of collsional parents with any children they may have into a single "impactors%id" index array + nimpactors = 2 + sum(nchild(:)) + allocate(impactors%id(nimpactors)) + impactors%id = [parent_child_index_array(1)%idx(:),parent_child_index_array(2)%idx(:)] + + impactors%ncoll = count(pl%lcollision(impactors%id(:))) + impactors%id = pack(impactors%id(:), pl%lcollision(impactors%id(:))) + impactors%Lspin(:,:) = 0.0_DP + impactors%Ip(:,:) = 0.0_DP + + ! Find the barycenter of each body along with its children, if it has any + do j = 1, 2 + impactors%rb(:, j) = pl%rh(:, idx_parent(j)) + cb%rb(:) + impactors%vb(:, j) = pl%vb(:, idx_parent(j)) + ! Assume principal axis rotation about axis corresponding to highest moment of inertia (3rd Ip) + if (param%lrotation) then + impactors%Ip(:, j) = impactors%mass(j) * pl%Ip(:, idx_parent(j)) + impactors%Lspin(:, j) = impactors%Ip(3, j) * impactors%radius(j)**2 * pl%rot(:, idx_parent(j)) + end if + + if (nchild(j) > 0) then + do i = 1, nchild(j) ! Loop over all children and take the mass weighted mean of the properties + idx_child = parent_child_index_array(j)%idx(i + 1) + if (.not. pl%lcollision(idx_child)) cycle + mchild = pl%mass(idx_child) + xchild(:) = pl%rh(:, idx_child) + cb%rb(:) + vchild(:) = pl%vb(:, idx_child) + volchild = (4.0_DP / 3.0_DP) * PI * pl%radius(idx_child)**3 + volume(j) = volume(j) + volchild + ! Get angular momentum of the child-parent pair and add that to the spin + ! Add the child's spin + if (param%lrotation) then + xcom(:) = (impactors%mass(j) * impactors%rb(:,j) + mchild * xchild(:)) / (impactors%mass(j) + mchild) + vcom(:) = (impactors%mass(j) * impactors%vb(:,j) + mchild * vchild(:)) / (impactors%mass(j) + mchild) + xc(:) = impactors%rb(:, j) - xcom(:) + vc(:) = impactors%vb(:, j) - vcom(:) + xcrossv(:) = xc(:) .cross. vc(:) + impactors%Lspin(:, j) = impactors%Lspin(:, j) + impactors%mass(j) * xcrossv(:) + + xc(:) = xchild(:) - xcom(:) + vc(:) = vchild(:) - vcom(:) + xcrossv(:) = xc(:) .cross. vc(:) + impactors%Lspin(:, j) = impactors%Lspin(:, j) + mchild * xcrossv(:) + + impactors%Lspin(:, j) = impactors%Lspin(:, j) + mchild * pl%Ip(3, idx_child) & + * pl%radius(idx_child)**2 & + * pl%rot(:, idx_child) + impactors%Ip(:, j) = impactors%Ip(:, j) + mchild * pl%Ip(:, idx_child) + end if + + ! Merge the child and parent + impactors%mass(j) = impactors%mass(j) + mchild + impactors%rb(:, j) = xcom(:) + impactors%vb(:, j) = vcom(:) + end do + end if + density(j) = impactors%mass(j) / volume(j) + impactors%radius(j) = (3 * volume(j) / (4 * PI))**(1.0_DP / 3.0_DP) + if (param%lrotation) impactors%Ip(:, j) = impactors%Ip(:, j) / impactors%mass(j) + end do + lflag = .true. + + xcom(:) = (impactors%mass(1) * impactors%rb(:, 1) + impactors%mass(2) * impactors%rb(:, 2)) / sum(impactors%mass(:)) + vcom(:) = (impactors%mass(1) * impactors%vb(:, 1) + impactors%mass(2) * impactors%vb(:, 2)) / sum(impactors%mass(:)) + mxc(:, 1) = impactors%mass(1) * (impactors%rb(:, 1) - xcom(:)) + mxc(:, 2) = impactors%mass(2) * (impactors%rb(:, 2) - xcom(:)) + vcc(:, 1) = impactors%vb(:, 1) - vcom(:) + vcc(:, 2) = impactors%vb(:, 2) - vcom(:) + impactors%Lorbit(:,:) = mxc(:,:) .cross. vcc(:,:) + + ! Destroy the kinship relationships for all members of this impactors%id + call pl%reset_kinship(impactors%id(:)) + + ! Set the coordinate system of the impactors + call impactors%set_coordinate_system() + + end associate + end select + return + end subroutine collision_resolve_consolidate_impactors + + + module subroutine collision_resolve_extract_plpl(self, nbody_system, param) + !! author: David A. Minton + !! + !! Processes the pl-pl encounter list remove only those encounters that led to a collision + !! + implicit none + ! Arguments + class(collision_list_plpl), intent(inout) :: self !! pl-pl 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 :: lplpl_collision + logical, dimension(:), allocatable :: lplpl_unique_parent + integer(I4B), dimension(:), pointer :: plparent + integer(I4B), dimension(:), allocatable :: collision_idx, unique_parent_idx + integer(I4B) :: i, index_coll, ncollisions, nunique_parent, nplplenc + + select type(nbody_system) + class is (swiftest_nbody_system) + select type (pl => nbody_system%pl) + class is (swiftest_pl) + associate(idx1 => self%index1, idx2 => self%index2, plparent => pl%kin%parent) + nplplenc = self%nenc + allocate(lplpl_collision(nplplenc)) + lplpl_collision(:) = self%status(1:nplplenc) == COLLIDED + if (.not.any(lplpl_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-pl encounters that lead to a collision + ncollisions = count(lplpl_collision(:)) + allocate(collision_idx(ncollisions)) + collision_idx = pack([(i, i=1, nplplenc)], lplpl_collision) + + ! Get the subset of collisions that involve a unique pair of parents + allocate(lplpl_unique_parent(ncollisions)) + + lplpl_unique_parent(:) = plparent(idx1(collision_idx(:))) /= plparent(idx2(collision_idx(:))) + nunique_parent = count(lplpl_unique_parent(:)) + allocate(unique_parent_idx(nunique_parent)) + 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 + ! due to restructuring of parent/child relationships when there are large numbers of multi-body collisions in a single + ! step + lplpl_unique_parent(:) = .true. + do index_coll = 1, ncollisions + associate(ip1 => plparent(idx1(collision_idx(index_coll))), ip2 => plparent(idx2(collision_idx(index_coll)))) + lplpl_unique_parent(:) = .not. ( any(plparent(idx1(unique_parent_idx(:))) == ip1) .or. & + any(plparent(idx2(unique_parent_idx(:))) == ip1) .or. & + any(plparent(idx1(unique_parent_idx(:))) == ip2) .or. & + any(plparent(idx2(unique_parent_idx(:))) == ip2) ) + 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. + 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. + end associate + end select + end select + + return + end subroutine collision_resolve_extract_plpl + + + module subroutine collision_resolve_extract_pltp(self, nbody_system, param) + implicit none + 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 + + return + end subroutine collision_resolve_extract_pltp + + + module subroutine collision_resolve_make_impactors_pl(pl, idx) + !! author: Jennifer L.L. Pouplin, Carlisle A. wishard, and David A. Minton + !! + !! When a single body is involved in more than one collision in a single step, it becomes part of a collision family + !! The largest body involved in a multi-body collision is the "parent" and all bodies that collide with it are its "children," + !! including those that collide with the children. + !! + !! Adapted from David E. Kaufmann's Swifter routine swiftest_merge_pl.f90 + !! + !! Adapted from Hal Levison's Swift routine symba5_merge.f + implicit none + ! Arguments + class(base_object), intent(inout) :: pl !! Swiftest massive body object + integer(I4B), dimension(:), intent(in) :: idx !! Array holding the indices of the two bodies involved in the collision + ! Internals + integer(I4B) :: i, j, index_parent, index_child, p1, p2 + integer(I4B) :: nchild_inherit, nchild_orig, nchild_new + integer(I4B), dimension(:), allocatable :: temp + + select type(pl) + class is (swiftest_pl) + + p1 = pl%kin(idx(1))%parent + p2 = pl%kin(idx(2))%parent + if (p1 == p2) return ! This is a collision between to children of a shared parent. We will ignore it. + + if (pl%mass(p1) > pl%mass(p2)) then + index_parent = p1 + index_child = p2 + else + index_parent = p2 + index_child = p1 + end if + + ! Expand the child array (or create it if necessary) and copy over the previous lists of children + nchild_orig = pl%kin(index_parent)%nchild + nchild_inherit = pl%kin(index_child)%nchild + nchild_new = nchild_orig + nchild_inherit + 1 + allocate(temp(nchild_new)) + + if (nchild_orig > 0) temp(1:nchild_orig) = pl%kin(index_parent)%child(1:nchild_orig) + ! Find out if the child body has any children of its own. The new parent wil inherit these children + if (nchild_inherit > 0) then + temp(nchild_orig+1:nchild_orig+nchild_inherit) = pl%kin(index_child)%child(1:nchild_inherit) + do i = 1, nchild_inherit + j = pl%kin(index_child)%child(i) + ! Set the childrens' parent to the new parent + pl%kin(j)%parent = index_parent + end do + end if + call pl%reset_kinship([index_child]) + ! Add the new child to its parent + pl%kin(index_child)%parent = index_parent + temp(nchild_new) = index_child + ! Save the new child array to the parent + pl%kin(index_parent)%nchild = nchild_new + call move_alloc(from=temp, to=pl%kin(index_parent)%child) + end select + + return + end subroutine collision_resolve_make_impactors_pl + + + module subroutine collision_resolve_mergeaddsub(nbody_system, param, t, status) + !! author: David A. Minton + !! + !! Fills the pl_discards and pl_adds with removed and added bodies + !! + use symba, only : symba_pl + implicit none + ! Arguments + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions + real(DP), intent(in) :: t !! Time of collision + integer(I4B), intent(in) :: status !! Status flag to assign to adds + ! Internals + integer(I4B) :: i, ibiggest, ismallest, iother, nstart, nend, nimpactors, nfrag + logical, dimension(:), allocatable :: lmask + class(swiftest_pl), allocatable :: plnew, plsub + character(*), parameter :: FRAGFMT = '("Newbody",I0.7)' + character(len=NAMELEN) :: newname, origin_type + + select type(nbody_system) + 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, npl => pl%nbody, & + collision_basic => 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 + nfrag = fragments%nbody + + param%maxid_collision = max(param%maxid_collision, maxval(nbody_system%pl%info(:)%collision_id)) + param%maxid_collision = param%maxid_collision + 1 + + ! Setup new bodies + allocate(plnew, mold=pl) + call plnew%setup(nfrag, param) + ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) + ismallest = impactors%id(minloc(pl%Gmass(impactors%id(:)), dim=1)) + + ! Copy over identification, information, and physical properties of the new bodies from the fragment list + plnew%id(1:nfrag) = fragments%id(1:nfrag) + plnew%rb(:, 1:nfrag) = fragments%rb(:, 1:nfrag) + plnew%vb(:, 1:nfrag) = fragments%vb(:, 1:nfrag) + plnew%status(1:nfrag) = ACTIVE + call plnew%b2h(cb) + plnew%mass(1:nfrag) = fragments%mass(1:nfrag) + plnew%Gmass(1:nfrag) = param%GU * fragments%mass(1:nfrag) + plnew%radius(1:nfrag) = fragments%radius(1:nfrag) + plnew%density(1:nfrag) = fragments%mass(1:nfrag) / fragments%radius(1:nfrag) + call plnew%set_rhill(cb) + + select case(status) + case(SUPERCATASTROPHIC) + plnew%status(1:nfrag) = NEW_PARTICLE + do i = 1, nfrag + write(newname, FRAGFMT) fragments%id(i) + call plnew%info(i)%set_value(origin_type="Supercatastrophic", origin_time=t, name=newname, & + origin_rh=plnew%rh(:,i), origin_vh=plnew%vh(:,i), & + collision_id=param%maxid_collision) + end do + do i = 1, nimpactors + if (impactors%id(i) == ibiggest) then + iother = ismallest + else + iother = ibiggest + end if + call pl%info(impactors%id(i))%set_value(status="Supercatastrophic", discard_time=t, & + discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), & + discard_body_id=iother) + end do + case(DISRUPTED,HIT_AND_RUN_DISRUPT) + if (status == DISRUPTED) then + write(origin_type,*) "Disruption" + else if (status == HIT_AND_RUN_DISRUPT) then + write(origin_type,*) "Hit and run fragmention" + end if + call plnew%info(1)%copy(pl%info(ibiggest)) + plnew%status(1) = OLD_PARTICLE + do i = 2, nfrag + write(newname, FRAGFMT) fragments%id(i) + call plnew%info(i)%set_value(origin_type=origin_type, origin_time=t, name=newname, & + origin_rh=plnew%rh(:,i), origin_vh=plnew%vh(:,i), & + collision_id=param%maxid_collision) + end do + do i = 1, nimpactors + if (impactors%id(i) == ibiggest) cycle + iother = ibiggest + call pl%info(impactors%id(i))%set_value(status=origin_type, discard_time=t, & + discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), & + discard_body_id=iother) + end do + case(MERGED) + call plnew%info(1)%copy(pl%info(ibiggest)) + plnew%status(1) = OLD_PARTICLE + do i = 1, nimpactors + if (impactors%id(i) == ibiggest) cycle + + iother = ibiggest + call pl%info(impactors%id(i))%set_value(status="MERGED", discard_time=t, discard_rh=pl%rh(:,i), & + discard_vh=pl%vh(:,i), discard_body_id=iother) + end do + end select + + if (param%lrotation) then + plnew%Ip(:, 1:nfrag) = fragments%Ip(:, 1:nfrag) + plnew%rot(:, 1:nfrag) = fragments%rot(:, 1:nfrag) + end if + + ! if (param%ltides) then + ! plnew%Q = pl%Q(ibiggest) + ! plnew%k2 = pl%k2(ibiggest) + ! plnew%tlag = pl%tlag(ibiggest) + ! end if + + !Copy over or set integration parameters for new bodies + plnew%lcollision(1:nfrag) = .false. + plnew%ldiscard(1:nfrag) = .false. + select type(pl) + class is (symba_pl) + select type(plnew) + class is (symba_pl) + plnew%levelg(1:nfrag) = pl%levelg(ibiggest) + plnew%levelm(1:nfrag) = pl%levelm(ibiggest) + end select + end select + + plnew%lmtiny(1:nfrag) = plnew%Gmass(1:nfrag) < param%GMTINY + where(plnew%lmtiny(1:nfrag)) + plnew%info(1:nfrag)%particle_type = PL_TINY_TYPE_NAME + elsewhere + plnew%info(1:nfrag)%particle_type = PL_TYPE_NAME + end where + + ! Log the properties of the new bodies + select type(after => collision_basic%after) + class is (swiftest_nbody_system) + allocate(after%pl, source=plnew) + end select + + ! Append the new merged body to the list + nstart = pl_adds%nbody + 1 + nend = pl_adds%nbody + nfrag + call pl_adds%append(plnew, lsource_mask=[(.true., i=1, nfrag)]) + + ! Add the discarded bodies to the discard list + pl%status(impactors%id(:)) = MERGED + pl%ldiscard(impactors%id(:)) = .true. + pl%lcollision(impactors%id(:)) = .true. + allocate(lmask, mold=pl%lmask) + lmask(:) = .false. + lmask(impactors%id(:)) = .true. + + call plnew%setup(0, param) + deallocate(plnew) + + allocate(plsub, mold=pl) + call pl%spill(plsub, lmask, ldestructive=.false.) + + nstart = pl_discards%nbody + 1 + nend = pl_discards%nbody + nimpactors + call pl_discards%append(plsub, lsource_mask=[(.true., i = 1, nimpactors)]) + + call plsub%setup(0, param) + deallocate(plsub) + end associate + + end select + end select + + return + end subroutine collision_resolve_mergeaddsub + + + module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) + !! author: David A. Minton + !! + !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the collision + !! + implicit none + ! Arguments + class(collision_list_plpl), intent(inout) :: self !! Swiftest pl-pl encounter list + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions + real(DP), intent(in) :: t !! Current simulation time + real(DP), intent(in) :: dt !! Current simulation step size + integer(I4B), intent(in) :: irec !! Current recursion level + ! Internals + real(DP) :: Eorbit_before, Eorbit_after + logical :: lplpl_collision + character(len=STRMAX) :: timestr + integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision + logical :: lgoodcollision + integer(I4B) :: i, loop, ncollisions + integer(I4B), parameter :: MAXCASCADE = 1000 + real(DP) :: dpe + + select type (nbody_system) + class is (swiftest_nbody_system) + select type(pl => nbody_system%pl) + class is (swiftest_pl) + select type(param) + 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) + if (plpl_collision%nenc == 0) return ! No collisions to resolve + + + ! Make sure that the heliocentric and barycentric coordinates are consistent with each other + call pl%vb2vh(nbody_system%cb) + call pl%rh2rb(nbody_system%cb) + + ! Get the energy before the collision is resolved + if (param%lenergy) then + call nbody_system%get_energy_and_momentum(param) + Eorbit_before = nbody_system%te + end if + + do loop = 1, MAXCASCADE + associate( idx1 => plpl_collision%index1, idx2 => plpl_collision%index2) + 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, "Collision between massive bodies detected at time t = " // & + trim(adjustl(timestr))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "***********************************************************" // & + "***********************************************************") + + do i = 1, ncollisions + idx_parent(1) = pl%kin(idx1(i))%parent + idx_parent(2) = pl%kin(idx2(i))%parent + call impactors%consolidate(nbody_system, param, idx_parent, lgoodcollision) + if ((.not. lgoodcollision) .or. any(pl%status(idx_parent(:)) /= COLLIDED)) cycle + call impactors%get_regime(nbody_system, param) + + call collision_history%take_snapshot(param,nbody_system, t, "before") + + call nbody_system%get_energy_and_momentum(param) + collider%pe(1) = nbody_system%pe + + call collider%generate(nbody_system, param, t) + + call nbody_system%get_energy_and_momentum(param) + + call collision_history%take_snapshot(param,nbody_system, t, "after") + + plpl_collision%status(i) = collider%status + call impactors%reset() + end do + + ! 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 + + ! Save the add/discard information to file + call nbody_system%write_discard(param) + + ! Rearrange the arrays: Remove discarded bodies, add any new bodies, resort, 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 + call nbody_system%pl_discards%setup(0, param) + call nbody_system%pl_adds%setup(0, param) + + ! 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 + write(*,*) + write(*,*) "An runaway collisional cascade has been detected in collision_resolve_plpl." + write(*,*) "Consider reducing the step size or changing the parameters in the collisional model to reduce the number of fragments." + call util_exit(FAILURE) + end if + end associate + end do + + if (param%lenergy) then + call nbody_system%get_energy_and_momentum(param) + Eorbit_after = nbody_system%te + nbody_system%Ecollisions = nbody_system%Ecollisions + (Eorbit_after - Eorbit_before) + end if + + end associate + end select + end select + end select + + return + end subroutine collision_resolve_plpl + + + module subroutine collision_resolve_pltp(self, nbody_system, param, t, dt, irec) + !! author: David A. Minton + !! + !! Process the pl-tp collision list, then modifiy the massive bodies based on the outcome of the collision + !! + implicit none + ! Arguments + class(collision_list_pltp), intent(inout) :: self !! Swiftest pl-pl encounter list + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions + 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 + + ! 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) + + ! Discard the collider + call nbody_system%tp%discard(nbody_system, param) + end select + end select + + return + end subroutine collision_resolve_pltp + +end submodule s_collision_resolve \ No newline at end of file diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 new file mode 100644 index 000000000..7f073eecf --- /dev/null +++ b/src/collision/collision_util.f90 @@ -0,0 +1,778 @@ +!! 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. + +submodule (collision) s_collision_util + use swiftest +contains + + module subroutine collision_util_add_fragments_to_collider(self, nbody_system, param) + !! Author: David A. Minton + !! + !! Adds fragments to the temporary system pl object + implicit none + ! Arguments + class(collision_basic), intent(in) :: self !! Collision system system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters + ! Internals + integer(I4B) :: i, npl_before, npl_after + logical, dimension(:), allocatable :: lexclude + + select type(nbody_system) + class is (swiftest_nbody_system) + associate(fragments => self%fragments, impactors => self%impactors, nfrag => self%fragments%nbody, pl => nbody_system%pl, cb => nbody_system%cb) + npl_after = pl%nbody + npl_before = npl_after - nfrag + allocate(lexclude(npl_after)) + + pl%status(npl_before+1:npl_after) = ACTIVE + pl%mass(npl_before+1:npl_after) = fragments%mass(1:nfrag) + pl%Gmass(npl_before+1:npl_after) = fragments%mass(1:nfrag) * param%GU + pl%radius(npl_before+1:npl_after) = fragments%radius(1:nfrag) + do concurrent (i = 1:nfrag) + pl%rb(:,npl_before+i) = fragments%rb(:,i) + pl%vb(:,npl_before+i) = fragments%vb(:,i) + pl%rh(:,npl_before+i) = fragments%rb(:,i) - cb%rb(:) + pl%vh(:,npl_before+i) = fragments%vb(:,i) - cb%vb(:) + end do + if (param%lrotation) then + pl%Ip(:,npl_before+1:npl_after) = fragments%Ip(:,1:nfrag) + pl%rot(:,npl_before+1:npl_after) = fragments%rot(:,1:nfrag) + end if + ! This will remove the impactors from the system since we've replaced them with fragments + lexclude(1:npl_after) = .false. + lexclude(impactors%id(1:impactors%ncoll)) = .true. + where(lexclude(1:npl_after)) + pl%status(1:npl_after) = INACTIVE + elsewhere + pl%status(1:npl_after) = ACTIVE + endwhere + + end associate + end select + + return + end subroutine collision_util_add_fragments_to_collider + + + module subroutine collision_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) + !! Author: David A. Minton + !! + !! Constructs a temporary internal system consisting of active bodies and additional fragments. This internal temporary system is used to calculate system energy with and without fragments + implicit none + ! Arguments + class(collision_basic), intent(inout) :: self !! Fraggle collision system object + class(base_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(base_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object + class(base_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters + ! Internals + logical, dimension(:), allocatable :: linclude + integer(I4B) :: npl_tot + ! The following are needed in order to deal with typing requirements + class(swiftest_nbody_system), allocatable :: tmpsys_local + class(swiftest_parameters), allocatable :: tmpparam_local + + select type(nbody_system) + class is (swiftest_nbody_system) + select type(param) + class is (swiftest_parameters) + associate(fragments => self%fragments, nfrag => self%fragments%nbody, pl => nbody_system%pl, npl => nbody_system%pl%nbody, cb => nbody_system%cb) + ! Set up a new system based on the original + if (allocated(tmpparam)) deallocate(tmpparam) + if (allocated(tmpsys)) deallocate(tmpsys) + allocate(tmpparam_local, source=param) + select type(tmpparam_local) + class is (swiftest_parameters) + tmpparam_local%system_history%nc%lfile_is_open = .false. + end select + call swiftest_util_setup_construct_system(tmpsys_local, tmpparam_local) + + ! No test particles necessary for energy/momentum calcs + call tmpsys_local%tp%setup(0, tmpparam_local) + + ! Replace the empty central body object with a copy of the original + deallocate(tmpsys_local%cb) + allocate(tmpsys_local%cb, source=cb) + + ! Make space for the fragments + npl_tot = npl + nfrag + call tmpsys_local%pl%setup(npl_tot, tmpparam_local) + allocate(linclude(npl_tot)) + + ! Fill up the temporary system with all of the original bodies, leaving the spaces for fragments empty until we add them in later + linclude(1:npl) = .true. + linclude(npl+1:npl_tot) = .false. + call tmpsys_local%pl%fill(pl, linclude) + + call move_alloc(tmpsys_local, tmpsys) + call move_alloc(tmpparam_local, tmpparam) + + end associate + end select + end select + + return + end subroutine collision_util_construct_temporary_system + + + module subroutine collision_util_get_idvalues_snapshot(self, idvals) + !! author: David A. Minton + !! + !! Returns an array of all id values saved in this snapshot + implicit none + ! Arguments + class(collision_snapshot), intent(in) :: self !! Fraggle snapshot object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot + ! Internals + integer(I4B) :: npl_before, ntp_before, npl_after, ntp_after, ntot, nlo, nhi + + select type(before => self%collider%before) + class is (swiftest_nbody_system) + select type(after => self%collider%after) + class is (swiftest_nbody_system) + npl_before = 0; ntp_before = 0; npl_after = 0; ntp_after = 0 + if (allocated(before%pl)) then + npl_before = before%pl%nbody + endif + + if (allocated(before%tp)) then + ntp_before = before%tp%nbody + end if + + if (allocated(after%pl)) then + npl_after = after%pl%nbody + end if + + if (allocated(after%tp)) then + ntp_after = after%tp%nbody + end if + + ntot = npl_before + ntp_before + npl_after + ntp_after + if (ntot == 0) return + allocate(idvals(ntot)) + + nlo = 1; nhi = npl_before + if (npl_before > 0) idvals(nlo:nhi) = before%pl%id(1:npl_before) + nlo = nhi + 1; nhi = nhi + ntp_before + if (ntp_before > 0) idvals(nlo:nhi) = before%tp%id(1:ntp_before) + + nlo = nhi + 1; nhi = nhi + npl_after + if (npl_after > 0) idvals(nlo:nhi) = after%pl%id(1:npl_after) + nlo = nhi + 1; nhi = nhi + ntp_after + if (ntp_after > 0) idvals(nlo:nhi) = after%tp%id(1:ntp_after) + end select + end select + + return + + end subroutine collision_util_get_idvalues_snapshot + + + module subroutine collision_util_get_angular_momentum(self) + !! Author: David A. Minton + !! + !! Calculates the current angular momentum of the fragments + implicit none + ! Arguments + class(collision_fragments(*)), intent(inout) :: self !! Fraggle fragment system object + ! Internals + integer(I4B) :: i + + associate(fragments => self, nfrag => self%nbody) + + do i = 1, nfrag + fragments%Lorbit(:,i) = fragments%mass(i) * (fragments%rc(:,i) .cross. fragments%vc(:, i)) + fragments%Lspin(:,i) = fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(:,i) * fragments%rot(:,i) + end do + + fragments%Lorbit_tot(:) = sum(fragments%Lorbit, dim=2) + fragments%Lspin_tot(:) = sum(fragments%Lspin, dim=2) + end associate + + return + end subroutine collision_util_get_angular_momentum + + + module subroutine collision_util_get_energy(self) + !! Author: David A. Minton + !! + !! Calculates the current energy of the fragments + implicit none + ! Argument + class(collision_fragments(*)), intent(inout) :: self !! Fragment system object + ! Internals + integer(I4B) :: i,j + real(DP), dimension(self%nbody) :: pepl + + associate(fragments => self, nfrag => self%nbody) + + do concurrent(i = 1:nfrag) + fragments%ke_orbit(i) = fragments%mass(i) * dot_product(fragments%vc(:,i), fragments%vc(:,i)) + fragments%ke_spin(i) = fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i) * dot_product(fragments%rot(:,i),fragments%rot(:,i) ) + end do + + fragments%ke_orbit(:) = fragments%ke_orbit(:) / 2 + fragments%ke_spin(:) = fragments%ke_spin(:) / 2 + fragments%ke_orbit_tot = sum(fragments%ke_orbit(:)) + fragments%ke_spin_tot = sum(fragments%ke_spin(:)) + + fragments%pe = 0.0_DP + do i = 1, nfrag + do concurrent(j = i+1:nfrag) + pepl(j) = - (fragments%Gmass(i) * fragments%mass(j)) / .mag.(fragments%rc(:,i) - fragments%rc(:,j)) + end do + fragments%pe = fragments%pe + sum(pepl(i+1:nfrag)) + end do + fragments%be = -sum(3*fragments%Gmass(:)*fragments%mass(:)/(5*fragments%radius(:))) + + end associate + + return + end subroutine collision_util_get_energy + + + module subroutine collision_util_get_energy_momentum(self, nbody_system, param, lbefore) + !! Author: David A. Minton + !! + !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) + !! This subrourtine works by building a temporary internal massive body object out of the non-excluded bodies and optionally with fragments appended. + !! This will get passed to the energy calculation subroutine so that energy is computed exactly the same way is it is in the main program. + !! This will temporarily expand the massive body object in a temporary system object called tmpsys to feed it into symba_energy + implicit none + ! Arguments + class(collision_basic), intent(inout) :: self !! Encounter collision system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current swiftest run configuration parameters + logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the nbody_system, with impactors included and fragments excluded or vice versa + ! Internals + integer(I4B) :: stage,i,j + real(DP), dimension(NDIM) :: Lorbit, Lspin + real(DP) :: ke_orbit, ke_spin, pe, be + real(DP), dimension(self%fragments%nbody) :: pepl + + select type(nbody_system) + class is (swiftest_nbody_system) + select type(param) + class is (swiftest_parameters) + associate(fragments => self%fragments, impactors => self%impactors, nfrag => self%fragments%nbody, pl => nbody_system%pl, cb => nbody_system%cb) + + + if (lbefore) then + Lorbit(:) = sum(impactors%Lorbit(:,:), dim=2) + Lspin(:) = sum(impactors%Lspin(:,:), dim=2) + ke_orbit = 0.0_DP + ke_spin = 0.0_DP + do concurrent(i = 1:2) + ke_orbit = ke_orbit + impactors%mass(i) * dot_product(impactors%vc(:,i), impactors%vc(:,i)) + ke_spin = ke_spin + impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3,i) * dot_product(impactors%rot(:,i), impactors%rot(:,i)) + end do + ke_orbit = ke_orbit / 2 + ke_spin = ke_spin / 2 + + pe = -(impactors%Gmass(1) * impactors%mass(2)) / .mag.(impactors%rc(:,2) - impactors%rc(:,1)) + be = -sum(3*impactors%Gmass(:)*impactors%mass(:)/(5*impactors%radius(:))) + + else + call fragments%get_angular_momentum() + Lorbit(:) = fragments%Lorbit_tot(:) + Lspin(:) = fragments%Lspin_tot(:) + + call fragments%get_energy() + ke_orbit = fragments%ke_orbit_tot + ke_spin = fragments%ke_spin_tot + pe = fragments%pe + be = fragments%be + + end if + ! Calculate the current fragment energy and momentum balances + if (lbefore) then + stage = 1 + else + stage = 2 + end if + self%Lorbit(:,stage) = Lorbit(:) + self%Lspin(:,stage) = Lspin(:) + self%Ltot(:,stage) = Lorbit(:) + Lspin(:) + self%ke_orbit(stage) = ke_orbit + self%ke_spin(stage) = ke_spin + self%pe(stage) = pe + self%be(stage) = be + self%Etot(stage) = ke_orbit + ke_spin + pe + be + end associate + end select + end select + + return + end subroutine collision_util_get_energy_momentum + + + module subroutine collision_util_index_map(self) + !! author: David A. Minton + !! + !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + implicit none + ! Arguments + class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object + ! Internals + integer(I4B), dimension(:), allocatable :: idvals + real(DP), dimension(:), allocatable :: tvals + + call self%get_index_values(idvals, tvals) + + ! Consolidate ids to only unique values + call swiftest_util_unique(idvals,self%idvals,self%idmap) + self%nid = size(self%idvals) + + ! Don't consolidate time values (multiple collisions can happen in a single time step) + self%nt = size(self%tvals) + + return + end subroutine collision_util_index_map + + + module subroutine collision_util_reset_impactors(self) + !! author: David A. Minton + !! + !! Resets the collider object variables to 0 and deallocates the index and mass distributions + implicit none + ! Arguments + class(collision_impactors), intent(inout) :: self + + if (allocated(self%id)) deallocate(self%id) + if (allocated(self%mass_dist)) deallocate(self%mass_dist) + self%ncoll = 0 + self%rb(:,:) = 0.0_DP + self%vb(:,:) = 0.0_DP + self%rot(:,:) = 0.0_DP + self%Lspin(:,:) = 0.0_DP + self%Lorbit(:,:) = 0.0_DP + self%Ip(:,:) = 0.0_DP + self%mass(:) = 0.0_DP + self%radius(:) = 0.0_DP + self%Qloss = 0.0_DP + self%regime = 0 + + self%x_unit(:) = 0.0_DP + self%y_unit(:) = 0.0_DP + self%z_unit(:) = 0.0_DP + self%v_unit(:) = 0.0_DP + self%rbcom(:) = 0.0_DP + self%vbcom(:) = 0.0_DP + self%rbimp(:) = 0.0_DP + + return + end subroutine collision_util_reset_impactors + + + module subroutine collision_util_reset_fragments(self) + !! author: David A. Minton + !! + !! Deallocates all allocatables + implicit none + ! Arguments + class(collision_fragments(*)), intent(inout) :: self + + if (allocated(self%info)) deallocate(self%info) + self%mtot = 0.0_DP + self%status = 0 + self%rh(:,:) = 0.0_DP + self%vh(:,:) = 0.0_DP + self%rb(:,:) = 0.0_DP + self%vb(:,:) = 0.0_DP + self%rot(:,:) = 0.0_DP + self%Ip(:,:) = 0.0_DP + self%mass(:) = 0.0_DP + self%radius(:) = 0.0_DP + self%density(:) = 0.0_DP + self%rc(:,:) = 0.0_DP + self%vc(:,:) = 0.0_DP + self%r_unit(:,:) = 0.0_DP + self%t_unit(:,:) = 0.0_DP + self%n_unit(:,:) = 0.0_DP + + return + end subroutine collision_util_reset_fragments + + + module subroutine collision_util_reset_system(self) + !! author: David A. Minton + !! + !! Resets the collider nbody_system and deallocates all allocatables + implicit none + ! Arguments + class(collision_basic), intent(inout) :: self !! Collision system object + + select type(before => self%before) + class is (swiftest_nbody_system) + if (allocated(before%pl)) deallocate(before%pl) + if (allocated(before%tp)) deallocate(before%tp) + end select + select type(after => self%after) + class is (swiftest_nbody_system) + if (allocated(after%pl)) deallocate(after%pl) + if (allocated(after%tp)) deallocate(after%tp) + end select + + self%Lorbit(:,:) = 0.0_DP + self%Lspin(:,:) = 0.0_DP + self%Ltot(:,:) = 0.0_DP + self%ke_orbit(:) = 0.0_DP + self%ke_spin(:) = 0.0_DP + self%pe(:) = 0.0_DP + self%Etot(:) = 0.0_DP + + if (allocated(self%impactors)) call self%impactors%reset() + if (allocated(self%fragments)) deallocate(self%fragments) + + return + end subroutine collision_util_reset_system + + + module subroutine collision_util_set_budgets(self) + !! author: David A. Minton + !! + !! Sets the energy and momentum budgets of the fragments based on the collider values and the before/after values of energy and momentum + implicit none + ! Arguments + class(collision_basic), intent(inout) :: self !! Fraggle collision system object + + associate(impactors => self%impactors, fragments => self%fragments) + + fragments%L_budget(:) = self%Ltot(:,1) + fragments%E_budget = self%Etot(1) - impactors%Qloss + + end associate + + return + end subroutine collision_util_set_budgets + + + module subroutine collision_util_set_coordinate_collider(self) + !! author: David A. Minton + !! + !! Defines the collisional coordinate nbody_system, including the unit vectors of both the nbody_system and individual fragments. + implicit none + ! Arguments + class(collision_basic), intent(inout) :: self !! Collisional nbody_system + + associate(fragments => self%fragments, impactors => self%impactors, nfrag => self%fragments%nbody) + call impactors%set_coordinate_system() + + if (.not.allocated(self%fragments)) return + call fragments%set_coordinate_system() + + + end associate + + return + end subroutine collision_util_set_coordinate_collider + + + module subroutine collision_util_set_coordinate_fragments(self) + !! author: David A. Minton + !! + !! Defines the collisional coordinate nbody_system, including the unit vectors of both the nbody_system and individual fragments. + implicit none + ! Arguments + class(collision_fragments(*)), intent(inout) :: self !! Collisional nbody_system + + associate(fragments => self, nfrag => self%nbody) + if ((nfrag == 0) .or. (.not.any(fragments%rc(:,:) > 0.0_DP))) return + + fragments%rmag(:) = .mag. fragments%rc(:,:) + fragments%vmag(:) = .mag. fragments%vc(:,:) + fragments%rotmag(:) = .mag. fragments%rot(:,:) + + ! Define the radial, normal, and tangential unit vectors for each individual fragment + fragments%r_unit(:,:) = .unit. fragments%rc(:,:) + fragments%v_unit(:,:) = .unit. fragments%vc(:,:) + fragments%n_unit(:,:) = .unit. (fragments%rc(:,:) .cross. fragments%vc(:,:)) + fragments%t_unit(:,:) = -.unit. (fragments%r_unit(:,:) .cross. fragments%n_unit(:,:)) + end associate + + return + end subroutine collision_util_set_coordinate_fragments + + + module subroutine collision_util_set_coordinate_impactors(self) + !! author: David A. Minton + !! + !! Defines the collisional coordinate nbody_system, including the unit vectors of both the nbody_system and individual fragments. + implicit none + ! Arguments + class(collision_impactors), intent(inout) :: self !! Collisional nbody_system + ! Internals + real(DP), dimension(NDIM) :: delta_r, delta_v, Ltot + real(DP) :: L_mag, mtot + + associate(impactors => self) + delta_v(:) = impactors%vb(:, 2) - impactors%vb(:, 1) + delta_r(:) = impactors%rb(:, 2) - impactors%rb(:, 1) + + ! We will initialize fragments on a plane defined by the pre-impact nbody_system, with the z-axis aligned with the angular momentum vector + ! and the y-axis aligned with the pre-impact distance vector. + + ! y-axis is the separation distance + impactors%y_unit(:) = .unit.delta_r(:) + Ltot = impactors%Lorbit(:,1) + impactors%Lorbit(:,2) + impactors%Lspin(:,1) + impactors%Lspin(:,2) + + L_mag = .mag.Ltot(:) + if (L_mag > sqrt(tiny(L_mag))) then + impactors%z_unit(:) = .unit.Ltot(:) + else ! Not enough angular momentum to determine a z-axis direction. We'll just pick a random direction + call random_number(impactors%z_unit(:)) + impactors%z_unit(:) = .unit.impactors%z_unit(:) + end if + + ! The cross product of the y- by z-axis will give us the x-axis + impactors%x_unit(:) = impactors%y_unit(:) .cross. impactors%z_unit(:) + impactors%v_unit(:) = .unit.delta_v(:) + + ! Find the center of mass of the collisional system + mtot = sum(impactors%mass(:)) + impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / mtot + impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / mtot + + ! The center of mass coordinate position and velocities + impactors%rc(:,1) = impactors%rb(:,1) - impactors%rbcom(:) + impactors%rc(:,2) = impactors%rb(:,2) - impactors%rbcom(:) + impactors%vc(:,1) = impactors%vb(:,1) - impactors%vbcom(:) + impactors%vc(:,2) = impactors%vb(:,2) - impactors%vbcom(:) + + ! Find the point of impact between the two bodies + impactors%rbimp(:) = impactors%rb(:,1) + impactors%radius(1) * impactors%y_unit(:) - impactors%rbcom(:) + + ! Set the velocity direction as the "bounce" direction" for disruptions, and body 2's direction for hit and runs + if (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) then + impactors%bounce_unit(:) = .unit. impactors%vc(:,2) + else + impactors%bounce_unit(:) = .unit. (impactors%vc(:,2) - 2 * dot_product(impactors%vc(:,2),impactors%y_unit(:)) * impactors%y_unit(:)) + end if + + end associate + + return + end subroutine collision_util_set_coordinate_impactors + + + module subroutine collision_util_setup_collider(self, nbody_system) + !! author: David A. Minton + !! + !! Initializer for the encounter collision system. Sets up impactors and the before/after snapshots, + !! but not fragments. Those are setup later when the number of fragments is known. + implicit none + ! Arguments + class(collision_basic), intent(inout) :: self !! Encounter collision system object + class(base_nbody_system), intent(in) :: nbody_system !! Current nbody system. Used as a mold for the before/after snapshots + + call self%setup_impactors() + if (allocated(self%before)) deallocate(self%before) + if (allocated(self%after)) deallocate(self%after) + + allocate(self%before, mold=nbody_system) + allocate(self%after, mold=nbody_system) + + return + end subroutine collision_util_setup_collider + + + module subroutine collision_util_setup_impactors_collider(self) + !! author: David A. Minton + !! + !! Initializer for the impactors for the encounter collision system. Deallocates old impactors before creating new ones + implicit none + ! Arguments + class(collision_basic), intent(inout) :: self !! Encounter collision system object + + if (allocated(self%impactors)) deallocate(self%impactors) + allocate(collision_impactors :: self%impactors) + + return + end subroutine collision_util_setup_impactors_collider + + + module subroutine collision_util_setup_fragments_collider(self, nfrag) + !! author: David A. Minton + !! + !! Initializer for the fragments of the collision system. + implicit none + ! Arguments + class(collision_basic), intent(inout) :: self !! Encounter collision system object + integer(I4B), intent(in) :: nfrag !! Number of fragments to create + + if (allocated(self%fragments)) deallocate(self%fragments) + allocate(collision_fragments(nfrag) :: self%fragments) + self%fragments%nbody = nfrag + self%fragments%nbody = nfrag + self%fragments%status(:) = ACTIVE + self%fragments%rh(:,:) = 0.0_DP + self%fragments%vh(:,:) = 0.0_DP + self%fragments%rb(:,:) = 0.0_DP + self%fragments%vb(:,:) = 0.0_DP + self%fragments%rc(:,:) = 0.0_DP + self%fragments%vc(:,:) = 0.0_DP + self%fragments%rot(:,:) = 0.0_DP + self%fragments%Ip(:,:) = 0.0_DP + self%fragments%r_unit(:,:) = 0.0_DP + self%fragments%t_unit(:,:) = 0.0_DP + self%fragments%n_unit(:,:) = 0.0_DP + self%fragments%mass(:) = 0.0_DP + self%fragments%radius(:) = 0.0_DP + self%fragments%density(:) = 0.0_DP + self%fragments%rmag(:) = 0.0_DP + self%fragments%vmag(:) = 0.0_DP + self%fragments%Lorbit_tot(:) = 0.0_DP + self%fragments%Lspin_tot(:) = 0.0_DP + self%fragments%L_budget(:) = 0.0_DP + self%fragments%ke_orbit_tot = 0.0_DP + self%fragments%ke_spin_tot = 0.0_DP + self%fragments%E_budget = 0.0_DP + + return + end subroutine collision_util_setup_fragments_collider + + + module subroutine collision_util_shift_vector_to_origin(m_frag, vec_frag) + !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Adjusts the position or velocity of the fragments as needed to align them with the origin + implicit none + ! Arguments + real(DP), dimension(:), intent(in) :: m_frag !! Fragment masses + real(DP), dimension(:,:), intent(inout) :: vec_frag !! Fragment positions or velocities in the center of mass frame + + ! Internals + real(DP), dimension(NDIM) :: mvec_frag, COM_offset + integer(I4B) :: i, nfrag + real(DP) :: mtot + + mvec_frag(:) = 0.0_DP + mtot = sum(m_frag) + nfrag = size(m_frag) + + do i = 1, nfrag + mvec_frag = mvec_frag(:) + vec_frag(:,i) * m_frag(i) + end do + COM_offset(:) = -mvec_frag(:) / mtot + do i = 1, nfrag + vec_frag(:, i) = vec_frag(:, i) + COM_offset(:) + end do + + return + end subroutine collision_util_shift_vector_to_origin + + + subroutine collision_util_save_snapshot(collision_history, snapshot) + !! author: David A. Minton + !! + !! Checks the current size of the encounter storage 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(collision_storage(*)), allocatable, intent(inout) :: collision_history !! Collision history object + class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object + ! Internals + type(collision_storage(nframes=:)), allocatable :: tmp + integer(I4B) :: i, nnew, nold, nbig + + ! Advance the snapshot frame counter + collision_history%iframe = collision_history%iframe + 1 + + ! Check to make sure the current encounter_history object is big enough. If not, grow it by a factor of 2 + nnew = collision_history%iframe + nold = collision_history%nframes + + if (nnew > nold) then + nbig = nold + do while (nbig < nnew) + nbig = nbig * 2 + end do + allocate(collision_storage(nbig) :: tmp) + tmp%iframe = collision_history%iframe + call move_alloc(collision_history%nc, tmp%nc) + + do i = 1, nold + if (allocated(collision_history%frame(i)%item)) call move_alloc(collision_history%frame(i)%item, tmp%frame(i)%item) + end do + deallocate(collision_history) + call move_alloc(tmp,collision_history) + nnew = nbig + end if + + collision_history%frame(nnew) = snapshot + + return + end subroutine collision_util_save_snapshot + + + 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 + implicit none + ! Internals + class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + class(base_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 !! "before": takes a snapshot just before the collision. "after" takes the snapshot just after the collision. + ! Arguments + class(collision_snapshot), allocatable :: snapshot + class(swiftest_pl), allocatable :: pl + character(len=:), allocatable :: stage + + if (present(arg)) then + stage = arg + else + stage = "" + end if + + select type (nbody_system) + class is (swiftest_nbody_system) + select type(param) + class is (swiftest_parameters) + select case(stage) + case("before") + ! Saves the states of the bodies involved in the collision before the collision is resolved + associate (idx => nbody_system%collider%impactors%id, ncoll => nbody_system%collider%impactors%ncoll) + allocate(pl, mold=nbody_system%pl) + call pl%setup(ncoll, param) + pl%id(:) = nbody_system%pl%id(idx(:)) + pl%Gmass(:) = nbody_system%pl%Gmass(idx(:)) + pl%radius(:) = nbody_system%pl%radius(idx(:)) + pl%rot(:,:) = nbody_system%pl%rot(:,idx(:)) + pl%Ip(:,:) = nbody_system%pl%Ip(:,idx(:)) + pl%rh(:,:) = nbody_system%pl%rh(:,idx(:)) + pl%vh(:,:) = nbody_system%pl%vh(:,idx(:)) + pl%info(:) = nbody_system%pl%info(idx(:)) + select type (before => nbody_system%collider%before) + class is (swiftest_nbody_system) + call move_alloc(pl, before%pl) + end select + end associate + case("after") + allocate(collision_snapshot :: snapshot) + allocate(snapshot%collider, source=nbody_system%collider) + snapshot%t = t + call collision_util_save_snapshot(nbody_system%collision_history,snapshot) + case default + write(*,*) "collision_util_snapshot requies either 'before' or 'after' passed to 'arg'" + end select + end select + end select + + return + end subroutine collision_util_snapshot + + +end submodule s_collision_util \ No newline at end of file diff --git a/src/encounter/encounter_check.f90 b/src/encounter/encounter_check.f90 index 6d866fb50..330f3320b 100644 --- a/src/encounter/encounter_check.f90 +++ b/src/encounter/encounter_check.f90 @@ -7,19 +7,18 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (encounter_classes) s_encounter_check +submodule (encounter) s_encounter_check use swiftest contains - module subroutine encounter_check_all_plpl(param, npl, x, v, renc, dt, & - nenc, index1, index2, lvdotr) + module subroutine encounter_check_all_plpl(param, npl, x, v, renc, dt, nenc, index1, index2, lvdotr) !! author: David A. Minton !! !! Check for encounters between massive bodies. Choose between the standard triangular or the Sort & Sweep method based on user inputs !! implicit none ! Arguments - class(swiftest_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s + class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s integer(I4B), intent(in) :: npl !! Total number of massive bodies real(DP), dimension(:,:), intent(in) :: x !! Position vectors of massive bodies real(DP), dimension(:,:), intent(in) :: v !! Velocity vectors of massive bodies @@ -30,62 +29,61 @@ module subroutine encounter_check_all_plpl(param, npl, x, v, renc, dt, & integer(I4B), dimension(:), allocatable, intent(out) :: index2 !! List of indices for body 2 in each encounter logical, dimension(:), allocatable, intent(out) :: lvdotr !! Logical flag indicating the sign of v .dot. x ! Internals - type(interaction_timer), save :: itimer + !type(interaction_timer), save :: itimer logical, save :: lfirst = .true. logical, save :: skipit = .false. ! This will be used to ensure that the sort & sweep subroutine gets called at least once before timing it so that the extent array is nearly sorted when it is timed integer(I8B) :: nplpl = 0_I8B - if (param%ladaptive_encounters_plpl .and. (.not. skipit)) then - nplpl = (npl * (npl - 1) / 2) - if (nplpl > 0) then - if (lfirst) then - write(itimer%loopname, *) "encounter_check_all_plpl" - write(itimer%looptype, *) "ENCOUNTER_PLPL" - lfirst = .false. - itimer%step_counter = INTERACTION_TIMER_CADENCE - else - if (itimer%check(param, nplpl)) call itimer%time_this_loop(param, nplpl) - end if - else - param%lencounter_sas_plpl = .false. - end if - end if + ! if (param%ladaptive_encounters_plpl .and. (.not. skipit)) then + ! nplpl = (npl * (npl - 1) / 2) + ! if (nplpl > 0) then + ! if (lfirst) then + ! write(itimer%loopname, *) "encounter_check_all_plpl" + ! write(itimer%looptype, *) "ENCOUNTER_PLPL" + ! lfirst = .false. + ! itimer%step_counter = INTERACTION_TIMER_CADENCE + ! else + ! if (itimer%netcdf_io_check(param, nplpl)) call itimer%time_this_loop(param, nplpl) + ! end if + ! else + ! param%lencounter_sas_plpl = .false. + ! end if + ! end if - if (param%lencounter_sas_plpl) then - call encounter_check_all_sort_and_sweep_plpl(npl, x, v, renc, dt, nenc, index1, index2, lvdotr) - else + ! if (param%lencounter_sas_plpl) then + ! call encounter_check_all_sort_and_sweep_plpl(npl, x, v, renc, dt, nenc, index1, index2, lvdotr) + ! else call encounter_check_all_triangular_plpl(npl, x, v, renc, dt, nenc, index1, index2, lvdotr) - end if - - if (skipit) then - skipit = .false. - else - if (param%ladaptive_encounters_plpl .and. nplpl > 0) then - if (itimer%is_on) then - call itimer%adapt(param, nplpl) - skipit = .true. - end if - end if - end if + ! end if + + ! if (skipit) then + ! skipit = .false. + ! else + ! if (param%ladaptive_encounters_plpl .and. nplpl > 0) then + ! if (itimer%is_on) then + ! call itimer%adapt(param, nplpl) + ! skipit = .true. + ! end if + ! end if + ! end if return end subroutine encounter_check_all_plpl - module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, & - nenc, index1, index2, lvdotr) + module subroutine encounter_check_all_plplm(param, nplm, nplt, rplm, vplm, rplt, vplt, rencm, renct, dt, nenc, index1, index2, lvdotr) !! author: David A. Minton !! !! Check for encounters between fully interacting massive bodies partially interacting massive bodies. Choose between the standard triangular or the Sort & Sweep method based on user inputs !! implicit none ! Arguments - class(swiftest_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s + class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s integer(I4B), intent(in) :: nplm !! Total number of fully interacting massive bodies integer(I4B), intent(in) :: nplt !! Total number of partially interacting masive bodies (GM < GMTINY) - real(DP), dimension(:,:), intent(in) :: xplm !! Position vectors of fully interacting massive bodies + real(DP), dimension(:,:), intent(in) :: rplm !! Position vectors of fully interacting massive bodies real(DP), dimension(:,:), intent(in) :: vplm !! Velocity vectors of fully interacting massive bodies - real(DP), dimension(:,:), intent(in) :: xplt !! Position vectors of partially interacting massive bodies + real(DP), dimension(:,:), intent(in) :: rplt !! Position vectors of partially interacting massive bodies real(DP), dimension(:,:), intent(in) :: vplt !! Velocity vectors of partially interacting massive bodies real(DP), dimension(:), intent(in) :: rencm !! Critical radii of fully interacting massive bodies that defines an encounter real(DP), dimension(:), intent(in) :: renct !! Critical radii of partially interacting massive bodies that defines an encounter @@ -95,7 +93,7 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, integer(I4B), dimension(:), allocatable, intent(out) :: index2 !! List of indices for body 2 in each encounter logical, dimension(:), allocatable, intent(out) :: lvdotr !! Logical flag indicating the sign of v .dot. x ! Internals - type(interaction_timer), save :: itimer + ! type(interaction_timer), save :: itimer logical, save :: lfirst = .true. logical, save :: skipit = .false. integer(I8B) :: nplplm = 0_I8B @@ -104,54 +102,57 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, integer(I4B), dimension(:), allocatable :: plmplt_index1 !! List of indices for body 1 in each encounter in the plm-plt group integer(I4B), dimension(:), allocatable :: plmplt_index2 !! List of indices for body 2 in each encounter in the plm-lt group integer(I8B) :: plmplt_nenc !! Number of encounters of the plm-plt group - class(swiftest_parameters), allocatable :: tmp_param !! Temporary parameter structure to turn off adaptive timer for the pl-pl phase if necessary + class(base_parameters), allocatable :: tmp_param !! Temporary parameter structure to turn off adaptive timer for the pl-pl phase if necessary integer(I8B), dimension(:), allocatable :: ind integer(I4B), dimension(:), allocatable :: itmp logical, dimension(:), allocatable :: ltmp - if (param%ladaptive_encounters_plpl .and. (.not. skipit)) then - npl = nplm + nplt - nplplm = nplm * npl - nplm * (nplm + 1) / 2 - if (nplplm > 0) then - if (lfirst) then - write(itimer%loopname, *) "encounter_check_all_plpl" - write(itimer%looptype, *) "ENCOUNTER_PLPL" - lfirst = .false. - itimer%step_counter = INTERACTION_TIMER_CADENCE - else - if (itimer%check(param, nplplm)) call itimer%time_this_loop(param, nplplm) - end if - else - param%lencounter_sas_plpl = .false. - end if - end if + ! if (param%ladaptive_encounters_plpl .and. (.not. skipit)) then + ! npl = nplm + nplt + ! nplplm = nplm * npl - nplm * (nplm + 1) / 2 + ! if (nplplm > 0) then + ! if (lfirst) then + ! write(itimer%loopname, *) "encounter_check_all_plpl" + ! write(itimer%looptype, *) "ENCOUNTER_PLPL" + ! lfirst = .false. + ! itimer%step_counter = INTERACTION_TIMER_CADENCE + ! else + ! if (itimer%netcdf_io_check(param, nplplm)) call itimer%time_this_loop(param, nplplm) + ! end if + ! else + ! param%lencounter_sas_plpl = .false. + ! end if + ! end if allocate(tmp_param, source=param) + select type(tmp_param) + class is (swiftest_parameters) + tmp_param%system_history%nc%lfile_is_open = .false. + end select ! Turn off adaptive encounter checks for the pl-pl group tmp_param%ladaptive_encounters_plpl = .false. ! Start with the pl-pl group - call encounter_check_all_plpl(tmp_param, nplm, xplm, vplm, rencm, dt, nenc, index1, index2, lvdotr) - - if (param%lencounter_sas_plpl) then - call encounter_check_all_sort_and_sweep_plplm(nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, & - plmplt_nenc, plmplt_index1, plmplt_index2, plmplt_lvdotr) - else - call encounter_check_all_triangular_plplm(nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, & - plmplt_nenc, plmplt_index1, plmplt_index2, plmplt_lvdotr) - end if - - if (skipit) then - skipit = .false. - else - if (param%ladaptive_encounters_plpl .and. nplplm > 0) then - if (itimer%is_on) then - call itimer%adapt(param, nplplm) - skipit = .true. - end if - end if - end if + call encounter_check_all_plpl(tmp_param, nplm, rplm, vplm, rencm, dt, nenc, index1, index2, lvdotr) + + ! if (param%lencounter_sas_plpl) then + ! call encounter_check_all_sort_and_sweep_plplm(nplm, nplt, rplm, vplm, rplt, vplt, rencm, renct, dt, & + ! plmplt_nenc, plmplt_index1, plmplt_index2, plmplt_lvdotr) + ! else + call encounter_check_all_triangular_plplm(nplm, nplt, rplm, vplm, rplt, vplt, rencm, renct, dt, plmplt_nenc, plmplt_index1, plmplt_index2, plmplt_lvdotr) + ! end if + + ! if (skipit) then + ! skipit = .false. + ! else + ! if (param%ladaptive_encounters_plpl .and. nplplm > 0) then + ! if (itimer%is_on) then + ! call itimer%adapt(param, nplplm) + ! skipit = .true. + ! end if + ! end if + ! end if if (plmplt_nenc > 0) then ! Consolidate the two lists allocate(itmp(nenc+plmplt_nenc)) @@ -168,10 +169,10 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, call move_alloc(ltmp, lvdotr) nenc = nenc + plmplt_nenc - call util_sort(index1, ind) - call util_sort_rearrange(index1, ind, nenc) - call util_sort_rearrange(index2, ind, nenc) - call util_sort_rearrange(lvdotr, ind, nenc) + call swiftest_util_sort(index1, ind) + call swiftest_util_sort_rearrange(index1, ind, nenc) + call swiftest_util_sort_rearrange(index2, ind, nenc) + call swiftest_util_sort_rearrange(lvdotr, ind, nenc) end if @@ -179,18 +180,17 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, end subroutine encounter_check_all_plplm - module subroutine encounter_check_all_pltp(param, npl, ntp, xpl, vpl, xtp, vtp, renc, dt, & - nenc, index1, index2, lvdotr) + module subroutine encounter_check_all_pltp(param, npl, ntp, rpl, vpl, xtp, vtp, renc, dt, nenc, index1, index2, lvdotr) !! author: David A. Minton !! !! Check for encounters between massive bodies and test particles. Choose between the standard triangular or the Sort & Sweep method based on user inputs !! implicit none ! Arguments - class(swiftest_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s + class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s integer(I4B), intent(in) :: npl !! Total number of massive bodies integer(I4B), intent(in) :: ntp !! Total number of test particles - real(DP), dimension(:,:), intent(in) :: xpl !! Position vectors of massive bodies + real(DP), dimension(:,:), intent(in) :: rpl !! Position vectors of massive bodies real(DP), dimension(:,:), intent(in) :: vpl !! Velocity vectors of massive bodies real(DP), dimension(:,:), intent(in) :: xtp !! Position vectors of test particlse real(DP), dimension(:,:), intent(in) :: vtp !! Velocity vectors of test particles @@ -201,42 +201,42 @@ module subroutine encounter_check_all_pltp(param, npl, ntp, xpl, vpl, xtp, vtp, integer(I4B), dimension(:), allocatable, intent(out) :: index2 !! List of indices for body 2 in each encounter logical, dimension(:), allocatable, intent(out) :: lvdotr !! Logical flag indicating the sign of v .dot. x ! Internals - type(interaction_timer), save :: itimer + ! type(interaction_timer), save :: itimer logical, save :: lfirst = .true. logical, save :: lsecond = .false. integer(I8B) :: npltp = 0_I8B - if (param%ladaptive_encounters_pltp) then - npltp = npl * ntp - if (npltp > 0) then - if (lfirst) then - write(itimer%loopname, *) "encounter_check_all_pltp" - write(itimer%looptype, *) "ENCOUNTER_PLTP" - lfirst = .false. - lsecond = .true. - else - if (lsecond) then ! This ensures that the encounter check methods are run at least once prior to timing. Sort and sweep improves on the second pass due to the bounding box extents needing to be nearly sorted - call itimer%time_this_loop(param, npltp) - lsecond = .false. - else if (itimer%check(param, npltp)) then - lsecond = .true. - itimer%is_on = .false. - end if - end if - else - param%lencounter_sas_pltp = .false. - end if - end if - - if (param%lencounter_sas_pltp) then - call encounter_check_all_sort_and_sweep_pltp(npl, ntp, xpl, vpl, xtp, vtp, renc, dt, nenc, index1, index2, lvdotr) - else - call encounter_check_all_triangular_pltp(npl, ntp, xpl, vpl, xtp, vtp, renc, dt, nenc, index1, index2, lvdotr) - end if - - if (.not.lfirst .and. param%ladaptive_encounters_pltp .and. npltp > 0) then - if (itimer%is_on) call itimer%adapt(param, npltp) - end if + ! if (param%ladaptive_encounters_pltp) then + ! npltp = npl * ntp + ! if (npltp > 0) then + ! if (lfirst) then + ! write(itimer%loopname, *) "encounter_check_all_pltp" + ! write(itimer%looptype, *) "ENCOUNTER_PLTP" + ! lfirst = .false. + ! lsecond = .true. + ! else + ! if (lsecond) then ! This ensures that the encounter check methods are run at least once prior to timing. Sort and sweep improves on the second pass due to the bounding box extents needing to be nearly sorted + ! call itimer%time_this_loop(param, npltp) + ! lsecond = .false. + ! else if (itimer%netcdf_io_check(param, npltp)) then + ! lsecond = .true. + ! itimer%is_on = .false. + ! end if + ! end if + ! else + ! param%lencounter_sas_pltp = .false. + ! end if + ! end if + + ! if (param%lencounter_sas_pltp) then + ! call encounter_check_all_sort_and_sweep_pltp(npl, ntp, rpl, vpl, xtp, vtp, renc, dt, nenc, index1, index2, lvdotr) + ! else + call encounter_check_all_triangular_pltp(npl, ntp, rpl, vpl, xtp, vtp, renc, dt, nenc, index1, index2, lvdotr) + ! end if + + ! if (.not.lfirst .and. param%ladaptive_encounters_pltp .and. npltp > 0) then + ! if (itimer%is_on) call itimer%adapt(param, npltp) + ! end if return end subroutine encounter_check_all_pltp @@ -297,8 +297,7 @@ subroutine encounter_check_all_sort_and_sweep_plpl(npl, x, v, renc, dt, nenc, in end subroutine encounter_check_all_sort_and_sweep_plpl - subroutine encounter_check_all_sort_and_sweep_plplm(nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, & - nenc, index1, index2, lvdotr) + subroutine encounter_check_all_sort_and_sweep_plplm(nplm, nplt, rplm, vplm, rplt, vplt, rencm, renct, dt, nenc, index1, index2, lvdotr) !! author: David A. Minton !! !! Check for encounters between massive bodies and test particles. @@ -309,9 +308,9 @@ subroutine encounter_check_all_sort_and_sweep_plplm(nplm, nplt, xplm, vplm, xplt ! Arguments integer(I4B), intent(in) :: nplm !! Total number of fully interacting massive bodies integer(I4B), intent(in) :: nplt !! Total number of partially interacting masive bodies (GM < GMTINY) - real(DP), dimension(:,:), intent(in) :: xplm !! Position vectors of fully interacting massive bodies + real(DP), dimension(:,:), intent(in) :: rplm !! Position vectors of fully interacting massive bodies real(DP), dimension(:,:), intent(in) :: vplm !! Velocity vectors of fully interacting massive bodies - real(DP), dimension(:,:), intent(in) :: xplt !! Position vectors of partially interacting massive bodies + real(DP), dimension(:,:), intent(in) :: rplt !! Position vectors of partially interacting massive bodies real(DP), dimension(:,:), intent(in) :: vplt !! Velocity vectors of partially interacting massive bodies real(DP), dimension(:), intent(in) :: rencm !! Critical radii of fully interacting massive bodies that defines an encounter real(DP), dimension(:), intent(in) :: renct !! Critical radii of partially interacting massive bodies that defines an encounter @@ -338,7 +337,7 @@ subroutine encounter_check_all_sort_and_sweep_plplm(nplm, nplt, xplm, vplm, xplt end if !$omp parallel do default(private) schedule(static) & - !$omp shared(xplm, xplt, vplm, vplt, rencm, renct, boundingbox) & + !$omp shared(rplm, rplt, vplm, vplt, rencm, renct, boundingbox) & !$omp firstprivate(dt, nplm, nplt, ntot) do dim = 1, SWEEPDIM where(vplm(dim,1:nplm) < 0.0_DP) @@ -357,21 +356,20 @@ subroutine encounter_check_all_sort_and_sweep_plplm(nplm, nplt, xplm, vplm, xplt vpltshift_max(1:nplt) = 1 end where - call boundingbox%aabb(dim)%sort(ntot, [xplm(dim,1:nplm) - rencm(1:nplm) + vplmshift_min(1:nplm) * vplm(dim,1:nplm) * dt, & - xplt(dim,1:nplt) - renct(1:nplt) + vpltshift_min(1:nplt) * vplt(dim,1:nplt) * dt, & - xplm(dim,1:nplm) + rencm(1:nplm) + vplmshift_max(1:nplm) * vplm(dim,1:nplm) * dt, & - xplt(dim,1:nplt) + renct(1:nplt) + vpltshift_max(1:nplt) * vplt(dim,1:nplt) * dt]) + call boundingbox%aabb(dim)%sort(ntot, [rplm(dim,1:nplm) - rencm(1:nplm) + vplmshift_min(1:nplm) * vplm(dim,1:nplm) * dt, & + rplt(dim,1:nplt) - renct(1:nplt) + vpltshift_min(1:nplt) * vplt(dim,1:nplt) * dt, & + rplm(dim,1:nplm) + rencm(1:nplm) + vplmshift_max(1:nplm) * vplm(dim,1:nplm) * dt, & + rplt(dim,1:nplt) + renct(1:nplt) + vpltshift_max(1:nplt) * vplt(dim,1:nplt) * dt]) end do !$omp end parallel do - call boundingbox%sweep(nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, nenc, index1, index2, lvdotr) + call boundingbox%sweep(nplm, nplt, rplm, vplm, rplt, vplt, rencm, renct, dt, nenc, index1, index2, lvdotr) return end subroutine encounter_check_all_sort_and_sweep_plplm - subroutine encounter_check_all_sort_and_sweep_pltp(npl, ntp, xpl, vpl, xtp, vtp, rencpl, dt, & - nenc, index1, index2, lvdotr) + subroutine encounter_check_all_sort_and_sweep_pltp(npl, ntp, rpl, vpl, xtp, vtp, rencpl, dt, nenc, index1, index2, lvdotr) !! author: David A. Minton !! !! Check for encounters between massive bodies and test particles. @@ -382,7 +380,7 @@ subroutine encounter_check_all_sort_and_sweep_pltp(npl, ntp, xpl, vpl, xtp, vtp, ! Arguments integer(I4B), intent(in) :: npl !! Total number of massive bodies integer(I4B), intent(in) :: ntp !! Total number of test particles - real(DP), dimension(:,:), intent(in) :: xpl !! Position vectors of massive bodies + real(DP), dimension(:,:), intent(in) :: rpl !! Position vectors of massive bodies real(DP), dimension(:,:), intent(in) :: vpl !! Velocity vectors of massive bodies real(DP), dimension(:,:), intent(in) :: xtp !! Position vectors of massive bodies real(DP), dimension(:,:), intent(in) :: vtp !! Velocity vectors of massive bodies @@ -413,7 +411,7 @@ subroutine encounter_check_all_sort_and_sweep_pltp(npl, ntp, xpl, vpl, xtp, vtp, renctp(:) = 0.0_DP !$omp parallel do default(private) schedule(static) & - !$omp shared(xpl, xtp, vpl, vtp, rencpl, renctp, boundingbox) & + !$omp shared(rpl, xtp, vpl, vtp, rencpl, renctp, boundingbox) & !$omp firstprivate(dt, npl, ntp, ntot) do dim = 1, SWEEPDIM where(vpl(dim,1:npl) < 0.0_DP) @@ -432,14 +430,14 @@ subroutine encounter_check_all_sort_and_sweep_pltp(npl, ntp, xpl, vpl, xtp, vtp, vtpshift_max(1:ntp) = 1 end where - call boundingbox%aabb(dim)%sort(ntot, [xpl(dim,1:npl) - rencpl(1:npl) + vplshift_min(1:npl) * vpl(dim,1:npl) * dt, & + call boundingbox%aabb(dim)%sort(ntot, [rpl(dim,1:npl) - rencpl(1:npl) + vplshift_min(1:npl) * vpl(dim,1:npl) * dt, & xtp(dim,1:ntp) - renctp(1:ntp) + vtpshift_min(1:ntp) * vtp(dim,1:ntp) * dt, & - xpl(dim,1:npl) + rencpl(1:npl) + vplshift_max(1:npl) * vpl(dim,1:npl) * dt, & + rpl(dim,1:npl) + rencpl(1:npl) + vplshift_max(1:npl) * vpl(dim,1:npl) * dt, & xtp(dim,1:ntp) + renctp(1:ntp) + vtpshift_max(1:ntp) * vtp(dim,1:ntp) * dt]) end do !$omp end parallel do - call boundingbox%sweep(npl, ntp, xpl, vpl, xtp, vtp, rencpl, renctp, dt, nenc, index1, index2, lvdotr) + call boundingbox%sweep(npl, ntp, rpl, vpl, xtp, vtp, rencpl, renctp, dt, nenc, index1, index2, lvdotr) return end subroutine encounter_check_all_sort_and_sweep_pltp @@ -514,7 +512,7 @@ pure subroutine encounter_check_all_triangular_one(i, n, xi, yi, zi, vxi, vyi, v real(DP), dimension(:), intent(in) :: renc !! Array of encounter radii of all bodies real(DP), intent(in) :: dt !! Step size integer(I4B), dimension(:), intent(in) :: ind_arr !! Index array [1, 2, ..., n] - type(encounter_list), intent(out) :: lenci !! Output encounter lists containing number of encounters, the v.dot.r direction array, and the index list of encountering bodies + class(encounter_list), intent(out) :: lenci !! Output encounter lists containing number of encounters, the v.dot.r direction array, and the index list of encountering bodies ! Internals integer(I4B) :: j integer(I8B) :: nenci @@ -563,9 +561,9 @@ subroutine encounter_check_all_triangular_plpl(npl, x, v, renc, dt, nenc, index1 ! Internals integer(I4B) :: i integer(I4B), dimension(:), allocatable, save :: ind_arr - type(encounter_list), dimension(npl) :: lenc + type(collision_list_plpl), dimension(npl) :: lenc - call util_index_array(ind_arr, npl) + call swiftest_util_index_array(ind_arr, npl) !$omp parallel do default(private) schedule(static)& !$omp shared(x, v, renc, lenc, ind_arr) & @@ -586,7 +584,7 @@ subroutine encounter_check_all_triangular_plpl(npl, x, v, renc, dt, nenc, index1 end subroutine encounter_check_all_triangular_plpl - subroutine encounter_check_all_triangular_plplm(nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, & + subroutine encounter_check_all_triangular_plplm(nplm, nplt, rplm, vplm, rplt, vplt, rencm, renct, dt, & nenc, index1, index2, lvdotr) !! author: David A. Minton !! @@ -596,9 +594,9 @@ subroutine encounter_check_all_triangular_plplm(nplm, nplt, xplm, vplm, xplt, vp ! Arguments integer(I4B), intent(in) :: nplm !! Total number of fully interacting massive bodies integer(I4B), intent(in) :: nplt !! Total number of partially interacting masive bodies (GM < GMTINY) - real(DP), dimension(:,:), intent(in) :: xplm !! Position vectors of fully interacting massive bodies + real(DP), dimension(:,:), intent(in) :: rplm !! Position vectors of fully interacting massive bodies real(DP), dimension(:,:), intent(in) :: vplm !! Velocity vectors of fully interacting massive bodies - real(DP), dimension(:,:), intent(in) :: xplt !! Position vectors of partially interacting massive bodies + real(DP), dimension(:,:), intent(in) :: rplt !! Position vectors of partially interacting massive bodies real(DP), dimension(:,:), intent(in) :: vplt !! Velocity vectors of partially interacting massive bodies real(DP), dimension(:), intent(in) :: rencm !! Critical radii of fully interacting massive bodies that defines an encounter real(DP), dimension(:), intent(in) :: renct !! Critical radii of partially interacting massive bodies that defines an encounter @@ -610,17 +608,17 @@ subroutine encounter_check_all_triangular_plplm(nplm, nplt, xplm, vplm, xplt, vp ! Internals integer(I4B) :: i integer(I4B), dimension(:), allocatable, save :: ind_arr - type(encounter_list), dimension(nplm) :: lenc + type(collision_list_plpl), dimension(nplm) :: lenc - call util_index_array(ind_arr, nplt) + call swiftest_util_index_array(ind_arr, nplt) !$omp parallel do default(private) schedule(dynamic)& - !$omp shared(xplm, vplm, xplt, vplt, rencm, renct, lenc, ind_arr) & + !$omp shared(rplm, vplm, rplt, vplt, rencm, renct, lenc, ind_arr) & !$omp firstprivate(nplm, nplt, dt) do i = 1, nplm - call encounter_check_all_triangular_one(0, nplt, xplm(1,i), xplm(2,i), xplm(3,i), & + call encounter_check_all_triangular_one(0, nplt, rplm(1,i), rplm(2,i), rplm(3,i), & vplm(1,i), vplm(2,i), vplm(3,i), & - xplt(1,:), xplt(2,:), xplt(3,:), & + rplt(1,:), rplt(2,:), rplt(3,:), & vplt(1,:), vplt(2,:), vplt(3,:), & rencm(i), renct(:), dt, ind_arr(:), lenc(i)) if (lenc(i)%nenc > 0) lenc(i)%index1(:) = i @@ -633,7 +631,7 @@ subroutine encounter_check_all_triangular_plplm(nplm, nplt, xplm, vplm, xplt, vp end subroutine encounter_check_all_triangular_plplm - subroutine encounter_check_all_triangular_pltp(npl, ntp, xpl, vpl, xtp, vtp, renc, dt, & + subroutine encounter_check_all_triangular_pltp(npl, ntp, rpl, vpl, xtp, vtp, renc, dt, & nenc, index1, index2, lvdotr) !! author: David A. Minton !! @@ -643,7 +641,7 @@ subroutine encounter_check_all_triangular_pltp(npl, ntp, xpl, vpl, xtp, vtp, ren ! Arguments integer(I4B), intent(in) :: npl !! Total number of massive bodies integer(I4B), intent(in) :: ntp !! Total number of test particles - real(DP), dimension(:,:), intent(in) :: xpl !! Position vectors of massive bodies + real(DP), dimension(:,:), intent(in) :: rpl !! Position vectors of massive bodies real(DP), dimension(:,:), intent(in) :: vpl !! Velocity vectors of massive bodies real(DP), dimension(:,:), intent(in) :: xtp !! Position vectors of massive bodies real(DP), dimension(:,:), intent(in) :: vtp !! Velocity vectors of massive bodies @@ -656,17 +654,17 @@ subroutine encounter_check_all_triangular_pltp(npl, ntp, xpl, vpl, xtp, vtp, ren ! Internals integer(I4B) :: i integer(I4B), dimension(:), allocatable, save :: ind_arr - type(encounter_list), dimension(npl) :: lenc + type(collision_list_pltp), dimension(npl) :: lenc real(DP), dimension(ntp) :: renct - call util_index_array(ind_arr, ntp) + call swiftest_util_index_array(ind_arr, ntp) renct(:) = 0.0_DP !$omp parallel do default(private) schedule(dynamic)& - !$omp shared(xpl, vpl, xtp, vtp, renc, renct, lenc, ind_arr) & + !$omp shared(rpl, vpl, xtp, vtp, renc, renct, lenc, ind_arr) & !$omp firstprivate(npl, ntp, dt) do i = 1, npl - call encounter_check_all_triangular_one(0, ntp, xpl(1,i), xpl(2,i), xpl(3,i), & + call encounter_check_all_triangular_one(0, ntp, rpl(1,i), rpl(2,i), rpl(3,i), & vpl(1,i), vpl(2,i), vpl(3,i), & xtp(1,:), xtp(2,:), xtp(3,:), & vtp(1,:), vtp(2,:), vtp(3,:), & @@ -734,7 +732,7 @@ module subroutine encounter_check_collapse_ragged_list(ragged_list, n1, nenc, in !! Collapses a ragged index list (one encounter list per body) into a pair of index arrays and a vdotr logical array (optional) implicit none ! Arguments - type(encounter_list), dimension(:), intent(in) :: ragged_list !! The ragged encounter list + class(encounter_list), dimension(:), intent(in) :: ragged_list !! The ragged encounter list integer(I4B), intent(in) :: n1 !! Number of bodies 1 integer(I8B), intent(out) :: nenc !! Total number of encountersj integer(I4B), dimension(:), allocatable, intent(out) :: index1 !! Array of indices for body 1 @@ -807,10 +805,10 @@ subroutine encounter_check_remove_duplicates(n, nenc, index1, index2, lvdotr) return end if - call util_sort(index1, ind) - call util_sort_rearrange(index1, ind, nenc) - call util_sort_rearrange(index2, ind, nenc) - call util_sort_rearrange(lvdotr, ind, nenc) + call swiftest_util_sort(index1, ind) + call swiftest_util_sort_rearrange(index1, ind, nenc) + call swiftest_util_sort_rearrange(index2, ind, nenc) + call swiftest_util_sort_rearrange(lvdotr, ind, nenc) ! Get the bounds on the bodies in the first index ibeg(:) = n @@ -836,7 +834,7 @@ subroutine encounter_check_remove_duplicates(n, nenc, index1, index2, lvdotr) khi = iend(i) nenci = khi - klo + 1_I8B if (allocated(ind)) deallocate(ind) - call util_sort(index2(klo:khi), ind) + call swiftest_util_sort(index2(klo:khi), ind) index2(klo:khi) = itmp(klo - 1_I8B + ind(:)) do j = klo + 1_I8B, khi if (index2(j) == index2(j - 1_I8B)) lencounter(j) = .false. @@ -876,7 +874,7 @@ pure module subroutine encounter_check_sort_aabb_1D(self, n, extent_arr) ! Internals integer(I8B) :: i, k - call util_sort(extent_arr, self%ind) + call swiftest_util_sort(extent_arr, self%ind) do concurrent(k = 1_I8B:2_I8B * n) i = self%ind(k) @@ -891,7 +889,7 @@ pure module subroutine encounter_check_sort_aabb_1D(self, n, extent_arr) end subroutine encounter_check_sort_aabb_1D - module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, x1, v1, x2, v2, renc1, renc2, dt, & + module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, r1, v1, r2, v2, renc1, renc2, dt, & nenc, index1, index2, lvdotr) !! author: David A. Minton !! @@ -902,8 +900,8 @@ module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, x1, v1, x class(encounter_bounding_box), intent(inout) :: self !! Multi-dimensional bounding box structure integer(I4B), intent(in) :: n1 !! Number of bodies 1 integer(I4B), intent(in) :: n2 !! Number of bodies 2 - real(DP), dimension(:,:), intent(in) :: x1, v1 !! Array of position and velocity vectorrs for bodies 1 - real(DP), dimension(:,:), intent(in) :: x2, v2 !! Array of position and velocity vectorrs for bodies 2 + real(DP), dimension(:,:), intent(in) :: r1, v1 !! Array of position and velocity vectorrs for bodies 1 + real(DP), dimension(:,:), intent(in) :: r2, v2 !! Array of position and velocity vectorrs for bodies 2 real(DP), dimension(:), intent(in) :: renc1 !! Radius of encounter regions of bodies 1 real(DP), dimension(:), intent(in) :: renc2 !! Radius of encounter regions of bodies 2 real(DP), intent(in) :: dt !! Step size @@ -917,13 +915,13 @@ module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, x1, v1, x logical, dimension(SWEEPDIM,n1+n2) :: loverlap_by_dimension logical, dimension(SWEEPDIM,2*(n1+n2)) :: llist1 integer(I4B), dimension(SWEEPDIM,2*(n1+n2)) :: ext_ind - type(encounter_list), dimension(n1+n2) :: lenc !! Array of encounter lists (one encounter list per body) + type(collision_list_pltp), dimension(n1+n2) :: lenc !! Array of encounter lists (one encounter list per body) integer(I4B), dimension(:), allocatable, save :: ind_arr integer(I8B) :: ibeg, iend real(DP), dimension(2*(n1+n2)) :: xind, yind, zind, vxind, vyind, vzind, rencind ntot = n1 + n2 - call util_index_array(ind_arr, ntot) + call swiftest_util_index_array(ind_arr, ntot) do concurrent(dim = 1:SWEEPDIM) loverlap_by_dimension(dim,:) = (self%aabb(dim)%ibeg(:) + 1_I8B) < (self%aabb(dim)%iend(:) - 1_I8B) @@ -943,17 +941,17 @@ module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, x1, v1, x dim = 1 where(llist1(dim,:)) - xind(:) = x1(1,ext_ind(dim,:)) - yind(:) = x1(2,ext_ind(dim,:)) - zind(:) = x1(3,ext_ind(dim,:)) + xind(:) = r1(1,ext_ind(dim,:)) + yind(:) = r1(2,ext_ind(dim,:)) + zind(:) = r1(3,ext_ind(dim,:)) vxind(:) = v1(1,ext_ind(dim,:)) vyind(:) = v1(2,ext_ind(dim,:)) vzind(:) = v1(3,ext_ind(dim,:)) rencind(:) = renc1(ext_ind(dim,:)) elsewhere - xind(:) = x2(1,ext_ind(dim,:)) - yind(:) = x2(2,ext_ind(dim,:)) - zind(:) = x2(3,ext_ind(dim,:)) + xind(:) = r2(1,ext_ind(dim,:)) + yind(:) = r2(2,ext_ind(dim,:)) + zind(:) = r2(3,ext_ind(dim,:)) vxind(:) = v2(1,ext_ind(dim,:)) vyind(:) = v2(2,ext_ind(dim,:)) vzind(:) = v2(3,ext_ind(dim,:)) @@ -962,7 +960,7 @@ module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, x1, v1, x where(.not.loverlap(:)) lenc(:)%nenc = 0 !$omp parallel default(private) & - !$omp shared(self, ext_ind, lenc, loverlap, x1, v1, x2, v2, renc1, renc2, xind, yind, zind, vxind, vyind, vzind, rencind, llist1) & + !$omp shared(self, ext_ind, lenc, loverlap, r1, v1, r2, v2, renc1, renc2, xind, yind, zind, vxind, vyind, vzind, rencind, llist1) & !$omp firstprivate(ntot, n1, n2, dt, dim) ! Do the first group of bodies (i is in list 1, all the others are from list 2) @@ -972,7 +970,7 @@ module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, x1, v1, x ibeg = self%aabb(dim)%ibeg(i) + 1_I8B iend = self%aabb(dim)%iend(i) - 1_I8B nbox = iend - ibeg + 1 - call encounter_check_all_sweep_one(i, nbox, x1(1,i), x1(2,i), x1(3,i), v1(1,i), v1(2,i), v1(3,i), & + call encounter_check_all_sweep_one(i, nbox, r1(1,i), r1(2,i), r1(3,i), v1(1,i), v1(2,i), v1(3,i), & xind(ibeg:iend), yind(ibeg:iend), zind(ibeg:iend),& vxind(ibeg:iend), vyind(ibeg:iend), vzind(ibeg:iend), & renc1(i), rencind(ibeg:iend), dt, ext_ind(dim,ibeg:iend), & @@ -989,7 +987,7 @@ module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, x1, v1, x iend = self%aabb(dim)%iend(i) - 1_I8B nbox = iend - ibeg + 1 ii = i - n1 - call encounter_check_all_sweep_one(ii, nbox, x2(1,ii), x2(2,ii), x2(3,ii), v2(1,ii), v2(2,ii), v2(3,ii), & + call encounter_check_all_sweep_one(ii, nbox, r1(1,ii), r1(2,ii), r1(3,ii), v2(1,ii), v2(2,ii), v2(3,ii), & xind(ibeg:iend), yind(ibeg:iend), zind(ibeg:iend),& vxind(ibeg:iend), vyind(ibeg:iend), vzind(ibeg:iend), & renc2(ii), rencind(ibeg:iend), dt, ext_ind(dim,ibeg:iend), & @@ -1012,7 +1010,7 @@ module subroutine encounter_check_sweep_aabb_single_list(self, n, x, v, renc, dt !! author: David A. Minton !! !! Sweeps the sorted bounding box extents and returns the true encounters (combines broad and narrow phases) - !! Double list version (e.g. pl-tp or plm-plt) + !! Single list version (e.g. pl-pl) implicit none ! Arguments class(encounter_bounding_box), intent(inout) :: self !! Multi-dimensional bounding box structure @@ -1031,11 +1029,11 @@ module subroutine encounter_check_sweep_aabb_single_list(self, n, x, v, renc, dt logical, dimension(2*n) :: lencounteri real(DP), dimension(2*n) :: xind, yind, zind, vxind, vyind, vzind, rencind integer(I4B), dimension(SWEEPDIM,2*n) :: ext_ind - type(encounter_list), dimension(n) :: lenc !! Array of encounter lists (one encounter list per body) + type(collision_list_plpl), dimension(n) :: lenc !! Array of encounter lists (one encounter list per body) integer(I4B), dimension(:), allocatable, save :: ind_arr integer(I8B) :: ibeg, iend - call util_index_array(ind_arr, n) + call swiftest_util_index_array(ind_arr, n) dim = 1 ! Sweep the intervals for each of the massive bodies along one dimension diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 199169b35..cba31cfb8 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -7,96 +7,223 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (encounter_classes) s_encounter_io +submodule (encounter) s_encounter_io use swiftest contains + module subroutine encounter_io_netcdf_dump(self, param) + ! author: David A. Minton + !! + !! Dumps the time history of an encounter to file. + implicit none + ! Arguments + class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i + + select type(nc => self%nc) + class is (encounter_netcdf_parameters) + if (self%iframe > 0) then + ! Create and save the output files for this encounter and fragmentation + nc%file_number = nc%file_number + 1 + call self%make_index_map() + nc%time_dimsize = self%nt + nc%name_dimsize = self%nid + write(nc%file_name, '("encounter_",I0.6,".nc")') nc%file_number + call nc%initialize(param) + + do i = 1, self%iframe + if (allocated(self%frame(i)%item)) then + select type(snapshot => self%frame(i)%item) + class is (encounter_snapshot) + param%ioutput = self%tmap(i) + call snapshot%write_frame(self,param) + end select + else + exit + end if + end do + + call nc%close() + call self%reset() + end if + end select + + return + end subroutine encounter_io_netcdf_dump - module subroutine encounter_io_write_frame(iu, t, id1, id2, Gmass1, Gmass2, radius1, radius2, xh1, xh2, vh1, vh2) + + module subroutine encounter_io_netcdf_initialize_output(self, param) !! author: David A. Minton !! - !! Write a single frame of close encounter data to output binary files - !! - !! Adapted from David E. Kaufmann's Swifter routine: io_write_encounter.f90 - !! Adapted from Hal Levison's Swift routine io_write_encounter.f + !! Initialize a NetCDF encounter 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 ! Arguments - integer(I4B), intent(in) :: iu !! Open file unit number - real(DP), intent(in) :: t !! Time of encounter - integer(I4B), intent(in) :: id1, id2 !! ids of the two encountering bodies - real(DP), intent(in) :: Gmass1, Gmass2 !! G*mass of the two encountering bodies - real(DP), intent(in) :: radius1, radius2 !! Radii of the two encountering bodies - real(DP), dimension(:), intent(in) :: xh1, xh2 !! Heliocentric position vectors of the two encountering bodies - real(DP), dimension(:), intent(in) :: vh1, vh2 !! Heliocentric velocity vectors of the two encountering bodies + class(encounter_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(base_parameters), intent(in) :: param !! Current run configuration parameters ! Internals - character(len=STRMAX) :: errmsg + integer(I4B) :: nvar, varid, vartype + real(DP) :: dfill + real(SP) :: sfill + integer(I4B), parameter :: NO_FILL = 0 + logical :: fileExists + character(len=STRMAX) :: errmsg + integer(I4B) :: ndims + + associate(nc => self) + dfill = ieee_value(dfill, IEEE_QUIET_NAN) + sfill = ieee_value(sfill, IEEE_QUIET_NAN) + + select case (param%out_type) + case("NETCDF_FLOAT") + self%out_type = NF90_FLOAT + case("NETCDF_DOUBLE") + self%out_type = NF90_DOUBLE + case default + write(*,*) trim(adjustl(param%out_type)), " is an invalid OUT_TYPE" + end select + + ! Check if the file exists, and if it does, delete it + inquire(file=nc%file_name, exist=fileExists) + if (fileExists) then + open(unit=LUN, file=nc%file_name, status="old", err=667, iomsg=errmsg) + close(unit=LUN, status="delete") + end if + + call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_io_netcdf_initialize_output nf90_create" ) + nc%lfile_is_open = .true. + + ! Dimensions + call netcdf_io_check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_io_netcdf_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension + call netcdf_io_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "encounter_io_netcdf_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension + call netcdf_io_check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "encounter_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), "encounter_io_netcdf_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + + ! Dimension coordinates + call netcdf_io_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_netcdf_initialize_output nf90_def_var time_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_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), "encounter_io_netcdf_initialize_output nf90_def_var id_varid" ) + + ! Variables + call netcdf_io_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "encounter_io_netcdf_initialize_output nf90_def_var id_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "encounter_io_netcdf_initialize_output nf90_def_var ptype_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_netcdf_initialize_output nf90_def_var rh_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%vh_varid), "encounter_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%time_dimid], nc%Gmass_varid), "encounter_io_netcdf_initialize_output nf90_def_var Gmass_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_netcdf_initialize_output nf90_def_var loop_varid" ) + if (param%lclose) then + call netcdf_io_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_netcdf_initialize_output nf90_def_var radius_varid" ) + end if + 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%time_dimid], nc%Ip_varid), "encounter_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%time_dimid], nc%rot_varid), "encounter_io_netcdf_initialize_output nf90_def_var rot_varid" ) + end if + + call netcdf_io_check( nf90_inquire(nc%id, nVariables=nvar), "encounter_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), "encounter_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), "encounter_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), "encounter_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), "encounter_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), "encounter_io_netcdf_initialize_output nf90_def_var_fill NF90_CHAR" ) + end select + end do - write(iu, err=667, iomsg=errmsg) t - write(iu, err=667, iomsg=errmsg) id1, xh1(1), xh1(2), xh1(3), vh1(1), vh1(2), Gmass1, radius1 - write(iu, err=667, iomsg=errmsg) id2, xh2(1), xh2(2), xh2(3), vh2(1), vh2(2), Gmass2, radius2 + ! Take the file out of define mode + call netcdf_io_check( nf90_enddef(nc%id), "encounter_io_netcdf_initialize_output nf90_enddef" ) + + ! Add in the space dimension coordinates + call netcdf_io_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_io_netcdf_initialize_output nf90_put_var space" ) + + end associate return + 667 continue - write(*,*) "Error writing encounter file: " // trim(adjustl(errmsg)) + write(*,*) "Error creating encounter output file. " // trim(adjustl(errmsg)) call util_exit(FAILURE) - end subroutine + end subroutine encounter_io_netcdf_initialize_output + - module subroutine encounter_io_write_list(self, pl, encbody, param) + module subroutine encounter_io_netcdf_write_frame_snapshot(self, history, param) !! author: David A. Minton !! - !! Write the encounters to the output encounter binary files + !! Write a frame of output of an encounter trajectory. + use netcdf implicit none ! Arguments - class(encounter_list), intent(in) :: self !! Swiftest encounter list object - class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object - class(swiftest_body), intent(in) :: encbody !! Encountering body - Swiftest generic body object (pl or tp) - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure + class(encounter_storage(*)), intent(inout) :: history !! Encounter storage object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals - logical , save :: lfirst = .true. - integer(I4B) :: k, ierr - character(len=STRMAX) :: errmsg - - if (param%enc_out == "" .or. self%nenc == 0) return - - open(unit=LUN, file=param%enc_out, status='OLD', position='APPEND', form='UNFORMATTED', iostat=ierr, iomsg=errmsg) - if (ierr /= 0) then - if (lfirst) then - open(unit=LUN, file=param%enc_out, status='NEW', form='UNFORMATTED', err=667, iomsg=errmsg) - else - goto 667 - end if - end if - lfirst = .false. - - associate(ind1 => self%index1, ind2 => self%index2) - select type(encbody) - class is (swiftest_pl) - do k = 1, self%nenc - call encounter_io_write_frame(LUN, self%t(k), & - pl%id(ind1(k)), encbody%id(ind2(k)), & - pl%Gmass(ind1(k)), encbody%Gmass(ind2(k)), & - pl%radius(ind1(k)), encbody%radius(ind2(k)), & - self%x1(:,k), self%x2(:,k), & - self%v1(:,k), self%v2(:,k)) + integer(I4B) :: i, idslot, old_mode, npl, ntp + character(len=:), allocatable :: charstring + + select type(param) + class is (swiftest_parameters) + select type(pl => self%pl) + class is (swiftest_pl) + select type(tp => self%tp) + class is (swiftest_tp) + select type (nc => history%nc) + class is (encounter_netcdf_parameters) + associate(tslot => param%ioutput) + call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_io_netcdf_write_frame_snapshot nf90_set_fill" ) + + call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var time_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl loop_varid" ) + + npl = pl%nbody + do i = 1, npl + idslot = findloc(history%idvals,pl%id(i),dim=1) + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl id_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl vh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl Gmass_varid" ) + + if (param%lclose) call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl radius_varid" ) + + if (param%lrotation) then + call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl Ip_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl rotx_varid" ) + end if + + charstring = trim(adjustl(pl%info(i)%name)) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl 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], count=[len(charstring), 1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl particle_type_varid" ) end do - class is (swiftest_tp) - do k = 1, self%nenc - call encounter_io_write_frame(LUN, self%t(k), & - pl%id(ind1(k)), encbody%id(ind2(k)), & - pl%Gmass(ind1(k)), 0.0_DP, & - pl%radius(ind1(k)), 0.0_DP, & - self%x1(:,k), self%x2(:,k), & - self%v1(:,k), self%v2(:,k)) - end do - end select - end associate - close(unit = LUN, err = 667, iomsg = errmsg) + ntp = tp%nbody + do i = 1, ntp + idslot = findloc(history%idvals,tp%id(i),dim=1) + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var tp id_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var tp rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var tp vh_varid" ) + + charstring = trim(adjustl(tp%info(i)%name)) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var tp name_varid" ) + charstring = trim(adjustl(tp%info(i)%particle_type)) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var tp particle_type_varid" ) + end do + + call netcdf_io_check( nf90_set_fill(nc%id, old_mode, old_mode) ) + end associate + end select + end select + end select + end select return - 667 continue - write(*,*) "Error writing encounter file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine encounter_io_write_list + end subroutine encounter_io_netcdf_write_frame_snapshot end submodule s_encounter_io \ No newline at end of file diff --git a/src/modules/encounter_classes.f90 b/src/encounter/encounter_module.f90 similarity index 55% rename from src/modules/encounter_classes.f90 rename to src/encounter/encounter_module.f90 index bf209c477..32ff67d25 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/encounter/encounter_module.f90 @@ -7,40 +7,81 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -module encounter_classes +module encounter !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! !! Definition of classes and methods used to determine close encounters - use swiftest_globals - use swiftest_classes + use globals + use base + use netcdf_io implicit none public integer(I4B), parameter :: SWEEPDIM = 3 - type :: encounter_list - integer(I8B) :: nenc = 0 !! Total number of encounters - logical, dimension(:), allocatable :: lvdotr !! relative vdotr flag - integer(I4B), dimension(:), allocatable :: status !! status of the interaction - integer(I4B), dimension(:), allocatable :: index1 !! position of the first body in the encounter - integer(I4B), dimension(:), allocatable :: index2 !! position of the second body in the encounter - integer(I4B), dimension(:), allocatable :: id1 !! id of the first body in the encounter - integer(I4B), dimension(:), allocatable :: id2 !! id of the second body in the encounter - real(DP), dimension(:,:), allocatable :: x1 !! the position of body 1 in the encounter - real(DP), dimension(:,:), allocatable :: x2 !! the position of body 2 in the encounter - real(DP), dimension(:,:), allocatable :: v1 !! the velocity of body 1 in the encounter - real(DP), dimension(:,:), allocatable :: v2 !! the velocity of body 2 in the encounter - real(DP), dimension(:), allocatable :: t !! Time of encounter + type, abstract :: encounter_list + integer(I8B) :: nenc = 0 !! Total number of encounters + real(DP) :: t !! Time of encounter + logical :: lcollision !! Indicates if the encounter resulted in at least one collision + real(DP), dimension(:), allocatable :: tcollision !! Time of collision + logical, dimension(:), allocatable :: lclosest !! indicates that thie pair of bodies is in currently at its closest approach point + logical, dimension(:), allocatable :: lvdotr !! relative vdotr flag + integer(I4B), dimension(:), allocatable :: status !! status of the interaction + integer(I4B), dimension(:), allocatable :: index1 !! position of the first body in the encounter + integer(I4B), dimension(:), allocatable :: index2 !! position of the second body in the encounter + integer(I4B), dimension(:), allocatable :: id1 !! id of the first body in the encounter + integer(I4B), dimension(:), allocatable :: id2 !! id of the second body in the encounter + real(DP), dimension(:,:), allocatable :: r1 !! the position of body 1 in the encounter + real(DP), dimension(:,:), allocatable :: r2 !! the position of body 2 in the encounter + real(DP), dimension(:,:), allocatable :: v1 !! the velocity of body 1 in the encounter + real(DP), dimension(:,:), allocatable :: v2 !! the velocity of body 2 in the encounter + integer(I4B), dimension(:), allocatable :: level !! Recursion level (used in SyMBA) contains - procedure :: setup => encounter_setup_list !! A constructor that sets the number of encounters and allocates and initializes all arrays - procedure :: append => encounter_util_append_list !! Appends elements from one structure to another - procedure :: copy => encounter_util_copy_list !! Copies elements from the source encounter list into self. - procedure :: dealloc => encounter_util_dealloc_list !! Deallocates all allocatables - procedure :: spill => encounter_util_spill_list !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - procedure :: resize => encounter_util_resize_list !! Checks the current size of the encounter list against the required size and extends it by a factor of 2 more than requested if it is too small. - procedure :: write => encounter_io_write_list !! Write close encounter data to output binary file - final :: encounter_util_final_list !! Finalize the encounter list - deallocates all allocatables + procedure :: setup => encounter_util_setup_list !! A constructor that sets the number of encounters and allocates and initializes all arrays + procedure :: append => encounter_util_append_list !! Appends elements from one structure to another + procedure :: copy => encounter_util_copy_list !! Copies elements from the source encounter list into self. + procedure :: dealloc => encounter_util_dealloc_list !! Deallocates all allocatables + procedure :: spill => encounter_util_spill_list !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) + procedure :: resize => encounter_util_resize_list !! Checks the current size of the encounter list against the required size and extends it by a factor of 2 more than requested if it is too small. end type encounter_list + + + type :: encounter_snapshot + !! A simplified version of a SyMBA nbody system object for storing minimal snapshots of the system state during encounters + class(base_object), allocatable :: pl !! Massive body data structure + class(base_object), allocatable :: tp !! Test particle data structure + real(DP) :: t !! Simulation time when snapshot was taken + integer(I8B) :: iloop !! Loop number at time of snapshot + contains + procedure :: write_frame => encounter_io_netcdf_write_frame_snapshot !! Writes a frame of encounter data to file + procedure :: get_idvals => encounter_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot + final :: encounter_final_snapshot + end type encounter_snapshot + + !> NetCDF dimension and variable names for the enounter save object + type, extends(netcdf_parameters) :: encounter_netcdf_parameters + character(NAMELEN) :: loop_varname = "loopnum" !! Loop number for encounter + integer(I4B) :: loop_varid !! ID for the recursion level variable + integer(I4B) :: time_dimsize = 0 !! Number of time values in snapshot + integer(I4B) :: name_dimsize = 0 !! Number of potential id values in snapshot + integer(I4B) :: file_number = 1 !! The number to append on the output file + contains + procedure :: initialize => encounter_io_netcdf_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object + final :: encounter_final_netcdf_parameters !! Finalizer will close the NetCDF file + end type encounter_netcdf_parameters + + + !> A class that that is used to store simulation history data between file output + type, extends(base_storage) :: encounter_storage + class(encounter_netcdf_parameters), allocatable :: nc !! NetCDF object attached to this storage object + contains + procedure :: dump => encounter_io_netcdf_dump !! Dumps contents of encounter history to file + procedure :: get_index_values => encounter_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 => encounter_util_index_map !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + procedure :: take_snapshot => encounter_util_snapshot !! Take a minimal snapshot of the system through an encounter + final :: encounter_final_storage + end type encounter_storage + type encounter_bounding_box_1D integer(I4B) :: n !! Number of bodies with extents @@ -48,25 +89,27 @@ module encounter_classes integer(I8B), dimension(:), allocatable :: ibeg !! Beginning index for box integer(I8B), dimension(:), allocatable :: iend !! Ending index for box contains - procedure :: sort => encounter_check_sort_aabb_1D !! Sorts the bounding box extents along a single dimension prior to the sweep phase - procedure :: dealloc => encounter_util_dealloc_aabb !! Deallocates all allocatables - final :: encounter_util_final_aabb !! Finalize the axis-aligned bounding box (1D) - deallocates all allocatables + procedure :: sort => encounter_check_sort_aabb_1D !! Sorts the bounding box extents along a single dimension prior to the sweep phase + procedure :: dealloc => encounter_util_dealloc_aabb !! Deallocates all allocatables + final :: encounter_final_aabb !! Finalize the axis-aligned bounding box (1D) - deallocates all allocatables end type + type encounter_bounding_box type(encounter_bounding_box_1D), dimension(SWEEPDIM) :: aabb contains - procedure :: setup => encounter_setup_aabb !! Setup a new axis-aligned bounding box structure + procedure :: setup => encounter_util_setup_aabb !! Setup a new axis-aligned bounding box structure procedure :: sweep_single => encounter_check_sweep_aabb_single_list !! Sweeps the sorted bounding box extents and returns the encounter candidates procedure :: sweep_double => encounter_check_sweep_aabb_double_list !! Sweeps the sorted bounding box extents and returns the encounter candidates generic :: sweep => sweep_single, sweep_double end type + interface module subroutine encounter_check_all_plpl(param, npl, x, v, renc, dt, nenc, index1, index2, lvdotr) - use swiftest_classes, only: swiftest_parameters + use base, only: base_parameters implicit none - class(swiftest_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s + class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s integer(I4B), intent(in) :: npl !! Total number of massive bodies real(DP), dimension(:,:), intent(in) :: x !! Position vectors of massive bodies real(DP), dimension(:,:), intent(in) :: v !! Velocity vectors of massive bodies @@ -78,16 +121,16 @@ module subroutine encounter_check_all_plpl(param, npl, x, v, renc, dt, nenc, ind integer(I8B), intent(out) :: nenc !! Total number of encounters end subroutine encounter_check_all_plpl - module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, & + module subroutine encounter_check_all_plplm(param, nplm, nplt, rplm, vplm, rplt, vplt, rencm, renct, dt, & nenc, index1, index2, lvdotr) - use swiftest_classes, only: swiftest_parameters + use base, only: base_parameters implicit none - class(swiftest_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s + class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s integer(I4B), intent(in) :: nplm !! Total number of fully interacting massive bodies integer(I4B), intent(in) :: nplt !! Total number of partially interacting masive bodies (GM < GMTINY) - real(DP), dimension(:,:), intent(in) :: xplm !! Position vectors of fully interacting massive bodies + real(DP), dimension(:,:), intent(in) :: rplm !! Position vectors of fully interacting massive bodies real(DP), dimension(:,:), intent(in) :: vplm !! Velocity vectors of fully interacting massive bodies - real(DP), dimension(:,:), intent(in) :: xplt !! Position vectors of partially interacting massive bodies + real(DP), dimension(:,:), intent(in) :: rplt !! Position vectors of partially interacting massive bodies real(DP), dimension(:,:), intent(in) :: vplt !! Velocity vectors of partially interacting massive bodies real(DP), dimension(:), intent(in) :: rencm !! Critical radii of fully interacting massive bodies that defines an encounter real(DP), dimension(:), intent(in) :: renct !! Critical radii of partially interacting massive bodies that defines an encounter @@ -98,13 +141,13 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, logical, dimension(:), allocatable, intent(out) :: lvdotr !! Logical flag indicating the sign of v .dot. x end subroutine encounter_check_all_plplm - module subroutine encounter_check_all_pltp(param, npl, ntp, xpl, vpl, xtp, vtp, renc, dt, nenc, index1, index2, lvdotr) - use swiftest_classes, only: swiftest_parameters + module subroutine encounter_check_all_pltp(param, npl, ntp, rpl, vpl, xtp, vtp, renc, dt, nenc, index1, index2, lvdotr) + use base, only: base_parameters implicit none - class(swiftest_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s + class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s integer(I4B), intent(in) :: npl !! Total number of massive bodies integer(I4B), intent(in) :: ntp !! Total number of test particles - real(DP), dimension(:,:), intent(in) :: xpl !! Position vectors of massive bodies + real(DP), dimension(:,:), intent(in) :: rpl !! Position vectors of massive bodies real(DP), dimension(:,:), intent(in) :: vpl !! Velocity vectors of massive bodies real(DP), dimension(:,:), intent(in) :: xtp !! Position vectors of massive bodies real(DP), dimension(:,:), intent(in) :: vtp !! Velocity vectors of massive bodies @@ -129,7 +172,7 @@ end subroutine encounter_check_one module subroutine encounter_check_collapse_ragged_list(ragged_list, n1, nenc, index1, index2, lvdotr) implicit none - type(encounter_list), dimension(:), intent(in) :: ragged_list !! The ragged encounter list + class(encounter_list), dimension(:), intent(in) :: ragged_list !! The ragged encounter list integer(I4B), intent(in) :: n1 !! Number of bodies 1 integer(I8B), intent(out) :: nenc !! Total number of encountersj integer(I4B), dimension(:), allocatable, intent(out) :: index1 !! Array of indices for body 1 @@ -144,14 +187,14 @@ pure module subroutine encounter_check_sort_aabb_1D(self, n, extent_arr) real(DP), dimension(:), intent(in) :: extent_arr !! Array of extents of size 2*n end subroutine encounter_check_sort_aabb_1D - module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, x1, v1, x2, v2, renc1, renc2, dt, & + module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, r1, v1, r2, v2, renc1, renc2, dt, & nenc, index1, index2, lvdotr) implicit none class(encounter_bounding_box), intent(inout) :: self !! Multi-dimensional bounding box structure integer(I4B), intent(in) :: n1 !! Number of bodies 1 integer(I4B), intent(in) :: n2 !! Number of bodies 2 - real(DP), dimension(:,:), intent(in) :: x1, v1 !! Array of indices of bodies 1 - real(DP), dimension(:,:), intent(in) :: x2, v2 !! Array of indices of bodies 2 + real(DP), dimension(:,:), intent(in) :: r1, v1 !! Array of indices of bodies 1 + real(DP), dimension(:,:), intent(in) :: r2, v2 !! Array of indices of bodies 2 real(DP), dimension(:), intent(in) :: renc1 !! Radius of encounter regions of bodies 1 real(DP), dimension(:), intent(in) :: renc2 !! Radius of encounter regions of bodies 2 real(DP), intent(in) :: dt !! Step size @@ -174,38 +217,37 @@ module subroutine encounter_check_sweep_aabb_single_list(self, n, x, v, renc, dt logical, dimension(:), allocatable, intent(out) :: lvdotr !! Logical array indicating which pairs are approaching end subroutine encounter_check_sweep_aabb_single_list - module subroutine encounter_io_write_frame(iu, t, id1, id2, Gmass1, Gmass2, radius1, radius2, xh1, xh2, vh1, vh2) + module subroutine encounter_io_netcdf_dump(self, param) implicit none - integer(I4B), intent(in) :: iu !! Open file unit number - real(DP), intent(in) :: t !! Time of encounter - integer(I4B), intent(in) :: id1, id2 !! ids of the two encountering bodies - real(DP), intent(in) :: Gmass1, Gmass2 !! G*mass of the two encountering bodies - real(DP), intent(in) :: radius1, radius2 !! Radii of the two encountering bodies - real(DP), dimension(:), intent(in) :: xh1, xh2 !! Swiftestcentric position vectors of the two encountering bodies - real(DP), dimension(:), intent(in) :: vh1, vh2 !! Swiftestcentric velocity vectors of the two encountering bodies - end subroutine encounter_io_write_frame - - module subroutine encounter_io_write_list(self, pl, encbody, param) - use swiftest_classes, only : swiftest_pl, swiftest_body, swiftest_parameters + class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine encounter_io_netcdf_dump + + module subroutine encounter_io_netcdf_initialize_output(self, param) + implicit none + class(encounter_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(base_parameters), intent(in) :: param + end subroutine encounter_io_netcdf_initialize_output + + module subroutine encounter_io_netcdf_write_frame_snapshot(self, history, param) implicit none - class(encounter_list), intent(in) :: self !! Swiftest encounter list object - class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object - class(swiftest_body), intent(in) :: encbody !! Encountering body - Swiftest generic body object (pl or tp) - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine encounter_io_write_list + class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure + class(encounter_storage(*)), intent(inout) :: history !! Encounter storage object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine encounter_io_netcdf_write_frame_snapshot - module subroutine encounter_setup_aabb(self, n, n_last) + module subroutine encounter_util_setup_aabb(self, n, n_last) implicit none class(encounter_bounding_box), intent(inout) :: self !! Swiftest encounter structure integer(I4B), intent(in) :: n !! Number of objects with bounding box extents integer(I4B), intent(in) :: n_last !! Number of objects with bounding box extents the previous time this was called - end subroutine encounter_setup_aabb + end subroutine encounter_util_setup_aabb - module subroutine encounter_setup_list(self, n) + module subroutine encounter_util_setup_list(self, n) implicit none class(encounter_list), intent(inout) :: self !! Swiftest encounter structure integer(I8B), intent(in) :: n !! Number of encounters to allocate space for - end subroutine encounter_setup_list + end subroutine encounter_util_setup_list module subroutine encounter_util_append_list(self, source, lsource_mask) implicit none @@ -230,15 +272,23 @@ module subroutine encounter_util_dealloc_list(self) class(encounter_list), intent(inout) :: self !! Swiftest encounter list object end subroutine encounter_util_dealloc_list - module subroutine encounter_util_final_aabb(self) + + module subroutine encounter_util_get_idvalues_snapshot(self, idvals) implicit none - type(encounter_bounding_box_1D), intent(inout) :: self !!Bounding box structure along a single dimension - end subroutine encounter_util_final_aabb + class(encounter_snapshot), intent(in) :: self !! Encounter snapshot object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot + end subroutine encounter_util_get_idvalues_snapshot + + module subroutine encounter_util_get_vals_storage(self, idvals, tvals) + class(encounter_storage(*)), intent(in) :: self !! Encounter storages 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 encounter_util_get_vals_storage - module subroutine encounter_util_final_list(self) + module subroutine encounter_util_index_map(self) implicit none - type(encounter_list), intent(inout) :: self !! Swiftest encounter list object - end subroutine encounter_util_final_list + class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object + end subroutine encounter_util_index_map module subroutine encounter_util_resize_list(self, nnew) implicit none @@ -246,6 +296,15 @@ module subroutine encounter_util_resize_list(self, nnew) integer(I8B), intent(in) :: nnew !! New size of list needed end subroutine encounter_util_resize_list + module subroutine encounter_util_snapshot(self, param, nbody_system, t, arg) + implicit none + class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) + end subroutine encounter_util_snapshot + module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestructive) implicit none class(encounter_list), intent(inout) :: self !! Swiftest encounter list @@ -256,5 +315,70 @@ end subroutine encounter_util_spill_list end interface -end module encounter_classes + contains + + subroutine encounter_final_aabb(self) + !! author: David A. Minton + !! + !! Finalize the axis aligned bounding box (1D) - deallocates all allocatables + implicit none + ! Arguments + type(encounter_bounding_box_1D), intent(inout) :: self + + call self%dealloc() + + return + end subroutine encounter_final_aabb + + + subroutine encounter_final_netcdf_parameters(self) + !! author: David A. Minton + !! + !! Finalize the NetCDF by closing the file + implicit none + ! Arguments + type(encounter_netcdf_parameters), intent(inout) :: self + + call self%close() + + return + end subroutine encounter_final_netcdf_parameters + + + subroutine encounter_final_snapshot(self) + !! author: David A. Minton + !! + !! Deallocates allocatable arrays in an encounter snapshot + implicit none + ! Arguments + type(encounter_snapshot), intent(inout) :: self !! Encounter storage object + + if (allocated(self%pl)) deallocate(self%pl) + if (allocated(self%tp)) deallocate(self%tp) + self%t = 0.0_DP + + return + end subroutine encounter_final_snapshot + + + subroutine encounter_final_storage(self) + !! author: David A. Minton + !! + !! Deallocates allocatable arrays in an encounter snapshot + implicit none + ! Arguments + type(encounter_storage(*)), intent(inout) :: self !! Encounter storage object + ! Internals + integer(I4B) :: i + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) + end do + + return + + return + end subroutine encounter_final_storage + +end module encounter diff --git a/src/encounter/encounter_setup.f90 b/src/encounter/encounter_setup.f90 deleted file mode 100644 index 95b2680a0..000000000 --- a/src/encounter/encounter_setup.f90 +++ /dev/null @@ -1,112 +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. - -submodule (encounter_classes) s_encounter_setup - use swiftest -contains - - module subroutine encounter_setup_aabb(self, n, n_last) - !! author: David A. Minton - !! - !! Sets up or modifies an axis-aligned bounding box structure. - implicit none - ! Arguments - class(encounter_bounding_box), intent(inout) :: self !! Swiftest encounter structure - integer(I4B), intent(in) :: n !! Number of objects with bounding box extents - integer(I4B), intent(in) :: n_last !! Number of objects with bounding box extents the previous time this was called - ! Internals - integer(I4B) :: next, next_last, k, dim - integer(I4B), dimension(:), allocatable :: itmp - - next = 2 * n - next_last = 2 * n_last - - if (n > n_last) then ! The number of bodies has grown. Resize and append the new bodies - do dim = 1, SWEEPDIM - allocate(itmp(next)) - if (n_last > 0) itmp(1:next_last) = self%aabb(dim)%ind(1:next_last) - call move_alloc(itmp, self%aabb(dim)%ind) - self%aabb(dim)%ind(next_last+1:next) = [(k, k = next_last+1, next)] - end do - else ! The number of bodies has gone down. Resize and chop of the old indices - do dim = 1, SWEEPDIM - allocate(itmp(next)) - itmp(1:next) = pack(self%aabb(dim)%ind(1:next_last), self%aabb(dim)%ind(1:next_last) <= next) - call move_alloc(itmp, self%aabb(dim)%ind) - end do - end if - - do dim = 1, SWEEPDIM - if (allocated(self%aabb(dim)%ibeg)) deallocate(self%aabb(dim)%ibeg) - allocate(self%aabb(dim)%ibeg(n)) - if (allocated(self%aabb(dim)%iend)) deallocate(self%aabb(dim)%iend) - allocate(self%aabb(dim)%iend(n)) - end do - - return - end subroutine encounter_setup_aabb - - - module subroutine encounter_setup_list(self, n) - !! author: David A. Minton - !! - !! A constructor that sets the number of encounters and allocates and initializes all arrays - !! - implicit none - ! Arguments - class(encounter_list), intent(inout) :: self !! Swiftest encounter structure - integer(I8B), intent(in) :: n !! Number of encounters to allocate space for - - if (n < 0) return - - if (allocated(self%lvdotr)) deallocate(self%lvdotr) - if (allocated(self%status)) deallocate(self%status) - if (allocated(self%index1)) deallocate(self%index1) - if (allocated(self%index2)) deallocate(self%index2) - if (allocated(self%id1)) deallocate(self%id1) - if (allocated(self%id2)) deallocate(self%id2) - if (allocated(self%x1)) deallocate(self%x1) - if (allocated(self%x2)) deallocate(self%x2) - if (allocated(self%v1)) deallocate(self%v1) - if (allocated(self%v2)) deallocate(self%v2) - if (allocated(self%t)) deallocate(self%t) - - self%nenc = n - if (n == 0_I8B) return - - allocate(self%lvdotr(n)) - allocate(self%status(n)) - allocate(self%index1(n)) - allocate(self%index2(n)) - allocate(self%id1(n)) - allocate(self%id2(n)) - allocate(self%x1(NDIM,n)) - allocate(self%x2(NDIM,n)) - allocate(self%v1(NDIM,n)) - allocate(self%v2(NDIM,n)) - allocate(self%t(n)) - - self%lvdotr(:) = .false. - self%status(:) = INACTIVE - self%index1(:) = 0 - self%index2(:) = 0 - self%id1(:) = 0 - self%id2(:) = 0 - self%x1(:,:) = 0.0_DP - self%x2(:,:) = 0.0_DP - self%v1(:,:) = 0.0_DP - self%v2(:,:) = 0.0_DP - self%t(:) = 0.0_DP - - return - end subroutine encounter_setup_list - -end submodule s_encounter_setup - - \ No newline at end of file diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 09cf6107e..0377c290c 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (encounter_classes) s_encounter_util +submodule (encounter) s_encounter_util use swiftest contains @@ -26,17 +26,19 @@ module subroutine encounter_util_append_list(self, source, lsource_mask) nold = self%nenc nsrc = source%nenc - call util_append(self%lvdotr, source%lvdotr, nold, nsrc, lsource_mask) - call util_append(self%status, source%status, nold, nsrc, lsource_mask) - call util_append(self%index1, source%index1, nold, nsrc, lsource_mask) - call util_append(self%index2, source%index2, nold, nsrc, lsource_mask) - call util_append(self%id1, source%id1, nold, nsrc, lsource_mask) - call util_append(self%id2, source%id2, nold, nsrc, lsource_mask) - call util_append(self%x1, source%x1, nold, nsrc, lsource_mask) - call util_append(self%x2, source%x2, nold, nsrc, lsource_mask) - call util_append(self%v1, source%v1, nold, nsrc, lsource_mask) - call util_append(self%v2, source%v2, nold, nsrc, lsource_mask) - call util_append(self%t, source%t, nold, nsrc, lsource_mask) + call swiftest_util_append(self%tcollision, source%tcollision, nold, nsrc, lsource_mask) + call swiftest_util_append(self%lclosest, source%lclosest, nold, nsrc, lsource_mask) + call swiftest_util_append(self%lvdotr, source%lvdotr, nold, nsrc, lsource_mask) + call swiftest_util_append(self%status, source%status, nold, nsrc, lsource_mask) + call swiftest_util_append(self%index1, source%index1, nold, nsrc, lsource_mask) + call swiftest_util_append(self%index2, source%index2, nold, nsrc, lsource_mask) + call swiftest_util_append(self%id1, source%id1, nold, nsrc, lsource_mask) + call swiftest_util_append(self%id2, source%id2, nold, nsrc, lsource_mask) + call swiftest_util_append(self%r1, source%r1, nold, nsrc, lsource_mask) + call swiftest_util_append(self%r2, source%r2, nold, nsrc, lsource_mask) + call swiftest_util_append(self%v1, source%v1, nold, nsrc, lsource_mask) + call swiftest_util_append(self%v2, source%v2, nold, nsrc, lsource_mask) + call swiftest_util_append(self%level, source%level, nold, nsrc, lsource_mask) self%nenc = nold + count(lsource_mask(1:nsrc)) return @@ -54,17 +56,21 @@ module subroutine encounter_util_copy_list(self, source) associate(n => source%nenc) self%nenc = n - self%lvdotr(1:n) = source%lvdotr(1:n) + self%t = source%t + self%lcollision = source%lcollision + self%tcollision(1:n) = source%tcollision(1:n) + self%lclosest(1:n) = source%lclosest(1:n) + self%lvdotr(1:n) = source%lvdotr(1:n) self%status(1:n) = source%status(1:n) self%index1(1:n) = source%index1(1:n) self%index2(1:n) = source%index2(1:n) self%id1(1:n) = source%id1(1:n) self%id2(1:n) = source%id2(1:n) - self%x1(:,1:n) = source%x1(:,1:n) - self%x2(:,1:n) = source%x2(:,1:n) + self%r1(:,1:n) = source%r1(:,1:n) + self%r2(:,1:n) = source%r2(:,1:n) self%v1(:,1:n) = source%v1(:,1:n) self%v2(:,1:n) = source%v2(:,1:n) - self%t(1:n) = source%t(1:n) + self%level(1:n) = source%level(1:n) end associate return @@ -95,48 +101,146 @@ module subroutine encounter_util_dealloc_list(self) ! Arguments class(encounter_list), intent(inout) :: self + if (allocated(self%tcollision)) deallocate(self%tcollision) + if (allocated(self%lclosest)) deallocate(self%lclosest) if (allocated(self%lvdotr)) deallocate(self%lvdotr) if (allocated(self%status)) deallocate(self%status) if (allocated(self%index1)) deallocate(self%index1) if (allocated(self%index2)) deallocate(self%index2) if (allocated(self%id1)) deallocate(self%id1) if (allocated(self%id2)) deallocate(self%id2) - if (allocated(self%x1)) deallocate(self%x1) - if (allocated(self%x2)) deallocate(self%x2) + if (allocated(self%r1)) deallocate(self%r1) + if (allocated(self%r2)) deallocate(self%r2) if (allocated(self%v1)) deallocate(self%v1) if (allocated(self%v2)) deallocate(self%v2) - if (allocated(self%t)) deallocate(self%t) + if (allocated(self%level)) deallocate(self%level) return end subroutine encounter_util_dealloc_list - module subroutine encounter_util_final_aabb(self) + module subroutine encounter_util_get_idvalues_snapshot(self, idvals) !! author: David A. Minton !! - !! Finalize the axis aligned bounding box (1D) - deallocates all allocatables + !! Returns an array of all id values saved in this snapshot implicit none ! Arguments - type(encounter_bounding_box_1D), intent(inout) :: self + class(encounter_snapshot), intent(in) :: self !! Encounter snapshot object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot + ! Internals + integer(I4B) :: npl, ntp + + select type(pl => self%pl) + class is (swiftest_pl) + select type(tp => self%tp) + class is (swiftest_tp) + if (allocated(self%pl)) then + npl = pl%nbody + else + npl = 0 + end if + + if (allocated(self%tp)) then + ntp = tp%nbody + else + ntp = 0 + end if - call self%dealloc() + if (npl + ntp == 0) return + allocate(idvals(npl+ntp)) + if (npl > 0) idvals(1:npl) = pl%id(:) + if (ntp >0) idvals(npl+1:npl+ntp) = tp%id(:) + end select + end select + + return + + end subroutine encounter_util_get_idvalues_snapshot + + + module subroutine encounter_util_get_vals_storage(self, idvals, tvals) + !! author: David A. Minton + !! + !! Gets the id values in a self object, regardless of whether it is encounter of collision + ! Argument + class(encounter_storage(*)), intent(in) :: self !! Encounter storages 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 + ! Internals + integer(I4B) :: i, n, nlo, nhi, ntotal + integer(I4B), dimension(:), allocatable :: itmp + + associate(nsnaps => self%iframe) + + allocate(tvals(nsnaps)) + + tvals(:) = 0.0_DP + + ! First pass to get total number of ids + ntotal = 0 + do i = 1, nsnaps + if (allocated(self%frame(i)%item)) then + select type(snapshot => self%frame(i)%item) + class is (encounter_snapshot) + tvals(i) = snapshot%t + call snapshot%get_idvals(itmp) + if (allocated(itmp)) then + n = size(itmp) + ntotal = ntotal + n + end if + end select + end if + end do + + allocate(idvals(ntotal)) + nlo = 1 + ! Second pass to store all ids get all of the ids stored + do i = 1, nsnaps + if (allocated(self%frame(i)%item)) then + select type(snapshot => self%frame(i)%item) + class is (encounter_snapshot) + tvals(i) = snapshot%t + call snapshot%get_idvals(itmp) + if (allocated(itmp)) then + n = size(itmp) + nhi = nlo + n - 1 + idvals(nlo:nhi) = itmp(1:n) + nlo = nhi + 1 + end if + end select + end if + end do + + end associate return - end subroutine encounter_util_final_aabb + end subroutine encounter_util_get_vals_storage - module subroutine encounter_util_final_list(self) + module subroutine encounter_util_index_map(self) !! author: David A. Minton !! - !! Finalize the encounter list - deallocates all allocatables + !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id. + !! Basically this will make a unique list of ids that exist in all of the saved snapshots implicit none ! Arguments - type(encounter_list), intent(inout) :: self + class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object + ! Internals + integer(I4B), dimension(:), allocatable :: idvals + real(DP), dimension(:), allocatable :: tvals - call self%dealloc() + call encounter_util_get_vals_storage(self, idvals, tvals) + + ! Consolidate ids to only unique values + call swiftest_util_unique(idvals,self%idvals,self%idmap) + self%nid = size(self%idvals) + + ! Consolidate time values to only unique values + call swiftest_util_unique(tvals,self%tvals,self%tmap) + self%nt = size(self%tvals) return - end subroutine encounter_util_final_list + end subroutine encounter_util_index_map module subroutine encounter_util_resize_list(self, nnew) @@ -149,11 +253,11 @@ module subroutine encounter_util_resize_list(self, nnew) implicit none ! Arguments class(encounter_list), intent(inout) :: self !! Swiftest encounter list - integer(I8B), intent(in) :: nnew !! New size of list needed + integer(I8B), intent(in) :: nnew !! New size of list needed ! Internals class(encounter_list), allocatable :: enc_temp - integer(I8B) :: nold - logical :: lmalloc + integer(I8B) :: nold + logical :: lmalloc lmalloc = allocated(self%status) if (lmalloc) then @@ -177,6 +281,97 @@ module subroutine encounter_util_resize_list(self, nnew) end subroutine encounter_util_resize_list + module subroutine encounter_util_setup_aabb(self, n, n_last) + !! author: David A. Minton + !! + !! Sets up or modifies an axis-aligned bounding box structure. + implicit none + ! Arguments + class(encounter_bounding_box), intent(inout) :: self !! Swiftest encounter structure + integer(I4B), intent(in) :: n !! Number of objects with bounding box extents + integer(I4B), intent(in) :: n_last !! Number of objects with bounding box extents the previous time this was called + ! Internals + integer(I4B) :: next, next_last, k, dim + integer(I4B), dimension(:), allocatable :: itmp + + next = 2 * n + next_last = 2 * n_last + + if (n > n_last) then ! The number of bodies has grown. Resize and append the new bodies + do dim = 1, SWEEPDIM + allocate(itmp(next)) + if (n_last > 0) itmp(1:next_last) = self%aabb(dim)%ind(1:next_last) + call move_alloc(itmp, self%aabb(dim)%ind) + self%aabb(dim)%ind(next_last+1:next) = [(k, k = next_last+1, next)] + end do + else ! The number of bodies has gone down. Resize and chop of the old indices + do dim = 1, SWEEPDIM + allocate(itmp(next)) + itmp(1:next) = pack(self%aabb(dim)%ind(1:next_last), self%aabb(dim)%ind(1:next_last) <= next) + call move_alloc(itmp, self%aabb(dim)%ind) + end do + end if + + do dim = 1, SWEEPDIM + if (allocated(self%aabb(dim)%ibeg)) deallocate(self%aabb(dim)%ibeg) + allocate(self%aabb(dim)%ibeg(n)) + if (allocated(self%aabb(dim)%iend)) deallocate(self%aabb(dim)%iend) + allocate(self%aabb(dim)%iend(n)) + end do + + return + end subroutine encounter_util_setup_aabb + + + module subroutine encounter_util_setup_list(self, n) + !! author: David A. Minton + !! + !! A constructor that sets the number of encounters and allocates and initializes all arrays + !! + implicit none + ! Arguments + class(encounter_list), intent(inout) :: self !! Swiftest encounter structure + integer(I8B), intent(in) :: n !! Number of encounters to allocate space for + + if (n < 0) return + call self%dealloc() + + self%nenc = n + if (n == 0_I8B) return + self%t = 0.0_DP + + allocate(self%tcollision(n)) + allocate(self%lvdotr(n)) + allocate(self%lclosest(n)) + allocate(self%status(n)) + allocate(self%index1(n)) + allocate(self%index2(n)) + allocate(self%id1(n)) + allocate(self%id2(n)) + allocate(self%r1(NDIM,n)) + allocate(self%r2(NDIM,n)) + allocate(self%v1(NDIM,n)) + allocate(self%v2(NDIM,n)) + allocate(self%level(n)) + + self%tcollision(:) = 0.0_DP + self%lvdotr(:) = .false. + self%lclosest(:) = .false. + self%status(:) = INACTIVE + self%index1(:) = 0 + self%index2(:) = 0 + self%id1(:) = 0 + self%id2(:) = 0 + self%r1(:,:) = 0.0_DP + self%r2(:,:) = 0.0_DP + self%v1(:,:) = 0.0_DP + self%v2(:,:) = 0.0_DP + self%level(:) = 0 + + return + end subroutine encounter_util_setup_list + + module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestructive) !! author: David A. Minton !! @@ -185,23 +380,25 @@ module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestru ! Arguments class(encounter_list), intent(inout) :: self !! Swiftest encounter list class(encounter_list), 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 + 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 ! Internals integer(I8B) :: nenc_old associate(keeps => self) - call util_spill(keeps%lvdotr, discards%lvdotr, lspill_list, ldestructive) - call util_spill(keeps%status, discards%status, lspill_list, ldestructive) - call util_spill(keeps%index1, discards%index1, lspill_list, ldestructive) - call util_spill(keeps%index2, discards%index2, lspill_list, ldestructive) - call util_spill(keeps%id1, discards%id1, lspill_list, ldestructive) - call util_spill(keeps%id2, discards%id2, lspill_list, ldestructive) - call util_spill(keeps%x1, discards%x1, lspill_list, ldestructive) - call util_spill(keeps%x2, discards%x2, lspill_list, ldestructive) - call util_spill(keeps%v1, discards%v1, lspill_list, ldestructive) - call util_spill(keeps%v2, discards%v2, lspill_list, ldestructive) - call util_spill(keeps%t, discards%t, lspill_list, ldestructive) + call swiftest_util_spill(keeps%tcollision, discards%tcollision, lspill_list, ldestructive) + call swiftest_util_spill(keeps%lvdotr, discards%lvdotr, lspill_list, ldestructive) + call swiftest_util_spill(keeps%lclosest, discards%lclosest, lspill_list, ldestructive) + call swiftest_util_spill(keeps%status, discards%status, lspill_list, ldestructive) + call swiftest_util_spill(keeps%index1, discards%index1, lspill_list, ldestructive) + call swiftest_util_spill(keeps%index2, discards%index2, lspill_list, ldestructive) + call swiftest_util_spill(keeps%id1, discards%id1, lspill_list, ldestructive) + call swiftest_util_spill(keeps%id2, discards%id2, lspill_list, ldestructive) + call swiftest_util_spill(keeps%r1, discards%r1, lspill_list, ldestructive) + call swiftest_util_spill(keeps%r2, discards%r2, lspill_list, ldestructive) + call swiftest_util_spill(keeps%v1, discards%v1, lspill_list, ldestructive) + call swiftest_util_spill(keeps%v2, discards%v2, lspill_list, ldestructive) + call swiftest_util_spill(keeps%level, discards%level, lspill_list, ldestructive) nenc_old = keeps%nenc @@ -214,4 +411,277 @@ module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestru return end subroutine encounter_util_spill_list -end submodule s_encounter_util \ No newline at end of file + + subroutine encounter_util_save_snapshot(encounter_history, snapshot) + !! author: David A. Minton + !! + !! Checks the current size of the encounter storage 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(encounter_storage(*)), allocatable, intent(inout) :: encounter_history !! SyMBA encounter storage object + class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object + ! Internals + type(encounter_storage(nframes=:)), allocatable :: tmp + integer(I4B) :: i, nnew, nold, nbig + + ! Advance the snapshot frame counter + encounter_history%iframe = encounter_history%iframe + 1 + + ! Check to make sure the current encounter_history object is big enough. If not, grow it by a factor of 2 + nnew = encounter_history%iframe + nold = encounter_history%nframes + + if (nnew > nold) then + nbig = nold + do while (nbig < nnew) + nbig = nbig * 2 + end do + allocate(encounter_storage(nbig) :: tmp) + tmp%iframe = encounter_history%iframe + call move_alloc(encounter_history%nc, tmp%nc) + + do i = 1, nold + if (allocated(encounter_history%frame(i)%item)) call move_alloc(encounter_history%frame(i)%item, tmp%frame(i)%item) + end do + deallocate(encounter_history) + call move_alloc(tmp,encounter_history) + end if + + ! Find out which time slot this belongs in by searching for an existing slot + ! with the same value of time or the first available one + encounter_history%frame(nnew) = snapshot + + return + end subroutine encounter_util_save_snapshot + + + module subroutine encounter_util_snapshot(self, param, nbody_system, t, arg) + !! author: David A. Minton + !! + !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories + !! can be played back through the encounter + use symba + implicit none + ! Internals + class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) + ! Arguments + class(encounter_snapshot), allocatable :: snapshot + integer(I4B) :: i, pi, pj, k, npl_snap, ntp_snap, iflag + real(DP), dimension(NDIM) :: rrel, vrel, rcom, vcom + real(DP) :: Gmtot, a, q, capm, tperi + real(DP), dimension(NDIM,2) :: rb,vb + + if (.not.present(t)) then + write(*,*) "encounter_util_snapshot_encounter requires `t` to be passed" + return + end if + + if (.not.present(arg)) then + write(*,*) "encounter_util_snapshot_encounter requires `arg` to be passed" + return + end if + + select type(param) + class is (swiftest_parameters) + 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(npl => pl%nbody, ntp => tp%nbody) + if (npl + ntp == 0) return + allocate(encounter_snapshot :: snapshot) + allocate(snapshot%pl, mold=pl) + allocate(snapshot%tp, mold=tp) + snapshot%iloop = param%iloop + + select type(pl_snap => snapshot%pl) + class is (swiftest_pl) + select type(tp_snap => snapshot%tp) + class is (swiftest_tp) + + select case(arg) + case("trajectory") + snapshot%t = t + + npl_snap = npl + ntp_snap = ntp + + if (npl > 0) then + pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE + select type(pl) + class is (symba_pl) + select type(nbody_system) + class is (symba_nbody_system) + pl%lmask(1:npl) = pl%lmask(1:npl) .and. pl%levelg(1:npl) == nbody_system%irec + end select + end select + npl_snap = count(pl%lmask(1:npl)) + end if + if (ntp > 0) then + tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE + select type(tp) + class is (symba_tp) + select type(nbody_system) + class is (symba_nbody_system) + tp%lmask(1:ntp) = tp%lmask(1:ntp) .and. tp%levelg(1:ntp) == nbody_system%irec + end select + end select + ntp_snap = count(tp%lmask(1:ntp)) + end if + + if (npl_snap + ntp_snap == 0) return ! Nothing to snapshot + + pl_snap%nbody = npl_snap + + ! Take snapshot of the currently encountering massive bodies + if (npl_snap > 0) then + call pl_snap%setup(npl_snap, param) + select type (pl) + class is (symba_pl) + select type(pl_snap) + class is (symba_pl) + pl_snap%levelg(:) = pack(pl%levelg(1:npl), pl%lmask(1:npl)) + end select + end select + + pl_snap%id(:) = pack(pl%id(1:npl), pl%lmask(1:npl)) + pl_snap%info(:) = pack(pl%info(1:npl), pl%lmask(1:npl)) + pl_snap%Gmass(:) = pack(pl%Gmass(1:npl), pl%lmask(1:npl)) + do i = 1, NDIM + pl_snap%rh(i,:) = pack(pl%rh(i,1:npl), pl%lmask(1:npl)) + pl_snap%vh(i,:) = pack(pl%vb(i,1:npl), pl%lmask(1:npl)) + end do + if (param%lclose) then + pl_snap%radius(:) = pack(pl%radius(1:npl), pl%lmask(1:npl)) + end if + + if (param%lrotation) then + do i = 1, NDIM + pl_snap%Ip(i,:) = pack(pl%Ip(i,1:npl), pl%lmask(1:npl)) + pl_snap%rot(i,:) = pack(pl%rot(i,1:npl), pl%lmask(1:npl)) + end do + end if + call pl_snap%sort("id", ascending=.true.) + end if + + ! Take snapshot of the currently encountering test particles + tp_snap%nbody = ntp_snap + if (ntp_snap > 0) then + call tp_snap%setup(ntp_snap, param) + tp_snap%id(:) = pack(tp%id(1:ntp), tp%lmask(1:ntp)) + tp_snap%info(:) = pack(tp%info(1:ntp), tp%lmask(1:ntp)) + do i = 1, NDIM + tp_snap%rh(i,:) = pack(tp%rh(i,1:ntp), tp%lmask(1:ntp)) + tp_snap%vh(i,:) = pack(tp%vh(i,1:ntp), tp%lmask(1:ntp)) + end do + end if + + ! Save the snapshot + select type (encounter_history => nbody_system%encounter_history) + class is (encounter_storage(*)) + encounter_history%nid = encounter_history%nid + ntp_snap + npl_snap + call encounter_util_save_snapshot(nbody_system%encounter_history,snapshot) + end select + case("closest") + associate(plpl_encounter => nbody_system%plpl_encounter, pltp_encounter => nbody_system%pltp_encounter) + if (any(plpl_encounter%lclosest(:))) then + call pl_snap%setup(2, param) + do k = 1, plpl_encounter%nenc + if (plpl_encounter%lclosest(k)) then + pi = plpl_encounter%index1(k) + pj = plpl_encounter%index2(k) + select type(pl_snap) + class is (symba_pl) + select type(pl) + class is (symba_pl) + pl_snap%levelg(:) = pl%levelg([pi,pj]) + end select + end select + pl_snap%id(:) = pl%id([pi,pj]) + pl_snap%info(:) = pl%info([pi,pj]) + pl_snap%Gmass(:) = pl%Gmass([pi,pj]) + Gmtot = sum(pl_snap%Gmass(:)) + if (param%lclose) pl_snap%radius(:) = pl%radius([pi,pj]) + if (param%lrotation) then + do i = 1, NDIM + pl_snap%Ip(i,:) = pl%Ip(i,[pi,pj]) + pl_snap%rot(i,:) = pl%rot(i,[pi,pj]) + end do + end if + + ! Compute pericenter passage time to get the closest approach parameters + rrel(:) = plpl_encounter%r2(:,k) - plpl_encounter%r1(:,k) + vrel(:) = plpl_encounter%v2(:,k) - plpl_encounter%v1(:,k) + call swiftest_orbel_xv2aqt(Gmtot, rrel(1), rrel(2), rrel(3), vrel(1), vrel(2), vrel(3), a, q, capm, tperi) + snapshot%t = t + tperi + if ((snapshot%t < maxval(pl_snap%info(:)%origin_time)) .or. & + (snapshot%t > minval(pl_snap%info(:)%discard_time))) cycle + + ! Computer the center mass of the pair + rcom(:) = (plpl_encounter%r1(:,k) * pl_snap%Gmass(1) + plpl_encounter%r2(:,k) * pl_snap%Gmass(2)) / Gmtot + vcom(:) = (plpl_encounter%v1(:,k) * pl_snap%Gmass(1) + plpl_encounter%v2(:,k) * pl_snap%Gmass(2)) / Gmtot + rb(:,1) = plpl_encounter%r1(:,k) - rcom(:) + rb(:,2) = plpl_encounter%r2(:,k) - rcom(:) + vb(:,1) = plpl_encounter%v1(:,k) - vcom(:) + vb(:,2) = plpl_encounter%v2(:,k) - vcom(:) + + ! Drift the relative orbit to get the new relative position and velocity + call swiftest_drift_one(Gmtot, rrel(1), rrel(2), rrel(3), vrel(1), vrel(2), vrel(3), tperi, iflag) + if (iflag /= 0) write(*,*) "Danby error in encounter_util_snapshot_encounter. Closest approach positions and vectors may not be accurate." + + ! Get the new position and velocity vectors + rb(:,1) = -(pl_snap%Gmass(2) / Gmtot) * rrel(:) + rb(:,2) = (pl_snap%Gmass(1)) / Gmtot * rrel(:) + + vb(:,1) = -(pl_snap%Gmass(2) / Gmtot) * vrel(:) + vb(:,2) = (pl_snap%Gmass(1)) / Gmtot * vrel(:) + + ! Move the CoM assuming constant velocity over the time it takes to reach periapsis + rcom(:) = rcom(:) + vcom(:) * tperi + + ! Compute the heliocentric position and velocity vector at periapsis + pl_snap%rh(:,1) = rb(:,1) + rcom(:) + pl_snap%rh(:,2) = rb(:,2) + rcom(:) + pl_snap%vh(:,1) = vb(:,1) + vcom(:) + pl_snap%vh(:,2) = vb(:,2) + vcom(:) + + call pl_snap%sort("id", ascending=.true.) + call encounter_util_save_snapshot(nbody_system%encounter_history,snapshot) + end if + end do + + plpl_encounter%lclosest(:) = .false. + end if + + if (any(pltp_encounter%lclosest(:))) then + do k = 1, pltp_encounter%nenc + end do + pltp_encounter%lclosest(:) = .false. + end if + end associate + case default + write(*,*) "encounter_util_snapshot_encounter requires `arg` to be either `trajectory` or `closest`" + end select + end select + end select + end associate + end select + end select + end select + end select + + return + end subroutine encounter_util_snapshot + + + +end submodule s_encounter_util diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index d59e2a9b7..cce8f2af1 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -7,37 +7,97 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(fraggle_classes) s_fraggle_generate +submodule(fraggle) s_fraggle_generate use swiftest - - integer(I4B), parameter :: NFRAG_MIN = 7 !! The minimum allowable number of fragments (set to 6 because that's how many unknowns are needed in the tangential velocity calculation) - real(DP), parameter :: F_SPIN_FIRST = 0.05_DP !! The initial try value of the fraction of energy or momenum in spin (whichever has the lowest kinetic energy) - real(DP), parameter :: FRAGGLE_LTOL = 10 * epsilon(1.0_DP) - real(DP), parameter :: FRAGGLE_ETOL = 1e-8_DP + use symba contains - module subroutine fraggle_generate_fragments(self, colliders, system, param, lfailure) + module subroutine fraggle_generate(self, nbody_system, param, t) + !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Create the fragments resulting from a non-catastrophic disruption collision + !! + implicit none + ! Arguments + class(collision_fraggle), intent(inout) :: self + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + ! Internals + integer(I4B) :: i, ibiggest, nfrag + character(len=STRMAX) :: message + + select type(nbody_system) + class is (swiftest_nbody_system) + select type(pl => nbody_system%pl) + class is (swiftest_pl) + associate(impactors => self%impactors, status => self%status) + select case (impactors%regime) + case (COLLRESOLVE_REGIME_HIT_AND_RUN) + call self%hitandrun(nbody_system, param, t) + return + case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) + call self%merge(nbody_system, param, t) ! Use the default collision model, which is merge + return + case(COLLRESOLVE_REGIME_DISRUPTION) + message = "Disruption between" + case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + message = "Supercatastrophic disruption between" + case default + write(*,*) "Error in swiftest_collision, unrecognized collision regime" + call util_exit(FAILURE) + end select + call self%set_mass_dist(param) + call self%disrupt(nbody_system, param, t) + + + associate (fragments => self%fragments) + ! Populate the list of new bodies + nfrag = fragments%nbody + write(message, *) nfrag + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") + select case(impactors%regime) + case(COLLRESOLVE_REGIME_DISRUPTION) + status = DISRUPTED + ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) + fragments%id(1) = pl%id(ibiggest) + fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] + param%maxid = fragments%id(nfrag) + case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + status = SUPERCATASTROPHIC + fragments%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] + param%maxid = fragments%id(nfrag) + end select + + call collision_resolve_mergeaddsub(nbody_system, param, t, status) + + end associate + end associate + end select + end select + return + end subroutine fraggle_generate + + + module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! - !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. + !! Generates a nbody_system of fragments in barycentric coordinates that conserves energy and momentum. use, intrinsic :: ieee_exceptions implicit none ! Arguments - class(fraggle_fragments), intent(inout) :: self !! Fraggle system object the outputs will be the fragmentation - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object containing the two-body equivalent values of the colliding bodies - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? - ! Internals - integer(I4B) :: i - integer(I4B) :: try - real(DP) :: r_max_start, f_spin, dEtot, dLmag - integer(I4B), parameter :: MAXTRY = 100 - logical :: lk_plpl + class(collision_fraggle), intent(inout) :: self !! Fraggle system object the outputs will be the fragmentation + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Time of collision + logical, optional, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? + ! Internals + logical :: lk_plpl, lfailure_local logical, dimension(size(IEEE_ALL)) :: fpe_halting_modes, fpe_quiet_modes - logical, dimension(size(IEEE_USUAL)) :: fpe_flag + real(DP) :: dE, dL character(len=STRMAX) :: message + real(DP), parameter :: fail_scale_initial = 1.001_DP ! The minimization and linear solvers can sometimes lead to floating point exceptions. Rather than halting the code entirely if this occurs, we ! can simply fail the attempt and try again. So we need to turn off any floating point exception halting modes temporarily @@ -45,537 +105,427 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa fpe_quiet_modes(:) = .false. call ieee_set_halting_mode(IEEE_ALL,fpe_quiet_modes) - associate(frag => self, nfrag => self%nbody, pl => system%pl) + select type(nbody_system) + class is (swiftest_nbody_system) + select type(param) + class is (swiftest_parameters) + select type(fragments => self%fragments) + class is (fraggle_fragments(*)) + associate(impactors => self%impactors, nfrag => fragments%nbody, pl => nbody_system%pl) write(message,*) nfrag - call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle generating " // trim(adjustl(message)) // " fragments.") - if (nfrag < NFRAG_MIN) then - write(message,*) "Fraggle needs at least ",NFRAG_MIN," fragments, but only ",nfrag," were given." - call io_log_one_message(FRAGGLE_LOG_OUT, message) - lfailure = .true. - return - end if - f_spin = F_SPIN_FIRST - - lk_plpl = allocated(pl%k_plpl) - if (lk_plpl) deallocate(pl%k_plpl) - - call frag%set_natural_scale(colliders) - - call frag%reset() - - ! Calculate the initial energy of the system without the collisional family - call frag%get_energy_and_momentum(colliders, system, param, lbefore=.true.) - - ! Start out the fragments close to the initial separation distance. This will be increased if there is any overlap or we fail to find a solution - r_max_start = 1 * norm2(colliders%xb(:,2) - colliders%xb(:,1)) - lfailure = .false. - try = 1 - do while (try < MAXTRY) - write(message,*) try - call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle try " // trim(adjustl(message))) - if (lfailure) then - call frag%restructure(colliders, try, f_spin, r_max_start) - call frag%reset() - try = try + 1 - end if - - lfailure = .false. - call ieee_set_flag(ieee_all, .false.) ! Set all fpe flags to quiet - - call fraggle_generate_pos_vec(frag, colliders, r_max_start) - call frag%set_coordinate_system(colliders) - - ! Initial velocity guess will be the barycentric velocity of the colliding system so that the budgets are based on the much smaller collisional-frame velocities - do concurrent (i = 1:nfrag) - frag%vb(:, i) = frag%vbcom(:) - end do - - call frag%get_energy_and_momentum(colliders, system, param, lbefore=.false.) - call frag%set_budgets() - - call fraggle_generate_spins(frag, f_spin, lfailure) - if (lfailure) then - call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find spins") - cycle - end if - - call fraggle_generate_tan_vel(frag, lfailure) - if (lfailure) then - call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find tangential velocities") - cycle - end if - - call fraggle_generate_rad_vel(frag, lfailure) - if (lfailure) then - call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find radial velocities") - cycle - end if + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle generating " // trim(adjustl(message)) // " fragments.") - call frag%get_energy_and_momentum(colliders, system, param, lbefore=.false.) - dEtot = frag%Etot_after - frag%Etot_before - dLmag = .mag. (frag%Ltot_after(:) - frag%Ltot_before(:)) - - lfailure = ((abs(dEtot + frag%Qloss) > FRAGGLE_ETOL) .or. (dEtot > 0.0_DP)) - if (lfailure) then - write(message, *) dEtot, abs(dEtot + frag%Qloss) / FRAGGLE_ETOL - call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed due to high energy error: " // & - trim(adjustl(message))) - cycle - end if - - lfailure = ((abs(dLmag) / (.mag.frag%Ltot_before)) > FRAGGLE_LTOL) - if (lfailure) then - write(message,*) dLmag / (.mag.frag%Ltot_before(:)) - call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed due to high angular momentum error: " // & - trim(adjustl(message))) - cycle - end if - - ! Check if any of the usual floating point exceptions happened, and fail the try if so - call ieee_get_flag(ieee_usual, fpe_flag) - lfailure = any(fpe_flag) - if (.not.lfailure) exit - write(message,*) "Fraggle failed due to a floating point exception: ", fpe_flag - call io_log_one_message(FRAGGLE_LOG_OUT, message) - end do - - write(message,*) try - if (lfailure) then - call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle fragment generation failed after " // & - trim(adjustl(message)) // " tries") - else - call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle fragment generation succeeded after " // & - trim(adjustl(message)) // " tries") - call fraggle_io_log_generate(frag) + if (param%lflatten_interactions) then + lk_plpl = allocated(pl%k_plpl) + if (lk_plpl) deallocate(pl%k_plpl) + else + lk_plpl = .false. end if + call ieee_set_flag(ieee_all, .false.) ! Set all fpe flags to quiet + + call self%set_natural_scale() + call fragments%reset() + lfailure_local = .false. + call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) + call self%set_budgets() + self%fail_scale = fail_scale_initial + call fraggle_generate_pos_vec(self) + call fraggle_generate_rot_vec(self) + call fraggle_generate_vel_vec(self,lfailure_local) + call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) + call self%set_original_scale() + dE = self%Etot(2) - self%Etot(1) + dL = .mag.(self%Ltot(:,2) - self%Ltot(:,1)) + + write(message,*) dE + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Estimated energy change: " // trim(adjustl(message))) + write(message,*) dL + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Estimated angular momentum change: " // trim(adjustl(message))) - call frag%set_original_scale(colliders) ! Restore the big array if (lk_plpl) call pl%flatten(param) + if (present(lfailure)) lfailure = lfailure_local end associate + end select + end select + end select call ieee_set_halting_mode(IEEE_ALL,fpe_halting_modes) ! Save the current halting modes so we can turn them off temporarily return - end subroutine fraggle_generate_fragments + end subroutine fraggle_generate_disrupt - subroutine fraggle_generate_pos_vec(frag, colliders, r_max_start) - !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + module subroutine fraggle_generate_hitandrun(self, nbody_system, param, t) + !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! - !! Initializes the orbits of the fragments around the center of mass. The fragments are initially placed on a plane defined by the - !! pre-impact angular momentum. They are distributed on an ellipse surrounding the center of mass. - !! The initial positions do not conserve energy or momentum, so these need to be adjusted later. + !! Create the fragments resulting from a non-catastrophic hit-and-run collision + !! implicit none ! Arguments - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object - real(DP), intent(in) :: r_max_start !! Initial guess for the starting maximum radial distance of fragments + class(collision_fraggle), intent(inout) :: self !! Collision system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + ! Result + integer(I4B) :: status !! Status flag assigned to this outcome ! Internals - real(DP) :: dis, rad, r_max - logical, dimension(:), allocatable :: loverlap - integer(I4B) :: i, j + integer(I4B) :: i, ibiggest, jtarg, jproj, nfrag + logical :: lpure + character(len=STRMAX) :: message + + select type(nbody_system) + class is (swiftest_nbody_system) + select type(pl => nbody_system%pl) + class is (swiftest_pl) + associate(impactors => self%impactors) + call collision_io_collider_message(nbody_system%pl, impactors%id, message) + if (impactors%mass(1) > impactors%mass(2)) then + jtarg = 1 + jproj = 2 + else + jtarg = 2 + jproj = 1 + end if - associate(nfrag => frag%nbody) - allocate(loverlap(nfrag)) + ! The Fraggle disruption model (and its extended types allow for non-pure hit and run. + if (impactors%mass_dist(2) > 0.9_DP * impactors%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Pure hit and run. No new fragments generated.") + nfrag = 0 + call self%collision_basic%hitandrun(nbody_system, param, t) + lpure = .true. + return + end if + lpure = .false. + call self%set_mass_dist(param) + message = "Hit and run between" + call swiftest_io_log_one_message(COLLISION_LOG_OUT, trim(adjustl(message))) + + ! Generate the position and velocity distributions of the fragments + call self%disrupt(nbody_system, param, t, lpure) + nfrag = self%fragments%nbody + + write(message, *) nfrag + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") + + ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) + self%fragments%id(1) = pl%id(ibiggest) + self%fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] + param%maxid = self%fragments%id(nfrag) + status = HIT_AND_RUN_DISRUPT + call collision_resolve_mergeaddsub(nbody_system, param, t, status) + end associate + end select + end select - ! Place the fragments into a region that is big enough that we should usually not have overlapping bodies - ! An overlapping bodies will collide in the next time step, so it's not a major problem if they do (it just slows the run down) - r_max = r_max_start - rad = sum(colliders%radius(:)) + return + end subroutine fraggle_generate_hitandrun - ! We will treat the first two fragments of the list as special cases. They get initialized the maximum distances apart along the original impactor distance vector. - ! This is done because in a regular disruption, the first body is the largest, the second the second largest, and the rest are smaller equal-mass fragments. - call random_number(frag%x_coll(:,3:nfrag)) + module subroutine fraggle_generate_pos_vec(collider) + !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Initializes the position vectors of the fragments around the center of mass based on the collision style. + !! For hit and run with disruption, the fragments are generated in a random cloud around the smallest of the two colliders (body 2) + !! For disruptive collisions, the fragments are generated in a random cloud around the impact point. Bodies are checked for overlap and + !! regenerated if they overlap. + implicit none + ! Arguments + class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object + ! Internals + real(DP) :: dis + real(DP), dimension(NDIM,2) :: fragment_cloud_center + real(DP), dimension(2) :: fragment_cloud_radius, rdistance + logical, dimension(collider%fragments%nbody) :: loverlap + integer(I4B) :: i, j, loop + logical :: lcat, lhitandrun + integer(I4B), parameter :: MAXLOOP = 20000 + real(DP), parameter :: rdistance_scale_factor = 0.20_DP ! Scale factor to apply to distance scaling of cloud centers in the event of overlap + ! The distance is chosen to be close to the original locations of the impactors + ! but far enough apart to prevent a collisional cascade between fragments + + associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) + lcat = (impactors%regime == COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + lhitandrun = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) + + ! We will treat the first two fragments of the list as special cases. + ! Place the first two bodies at the centers of the two fragment clouds, but be sure they are sufficiently far apart to avoid overlap loverlap(:) = .true. - do while (any(loverlap(3:nfrag))) - frag%x_coll(:, 1) = colliders%xb(:, 1) - frag%xbcom(:) - frag%x_coll(:, 2) = colliders%xb(:, 2) - frag%xbcom(:) - r_max = r_max + 0.1_DP * rad - do i = 3, nfrag - if (loverlap(i)) then - call random_number(frag%x_coll(:,i)) - frag%x_coll(:, i) = 2 * (frag%x_coll(:, i) - 0.5_DP) * r_max + rdistance(:) = rdistance_scale_factor * .mag.impactors%vc(:,:) + do loop = 1, MAXLOOP + if (.not.any(loverlap(:))) exit + fragment_cloud_center(:,1) = impactors%rc(:,1) - rdistance(1) * impactors%bounce_unit(:) + if (lcat) then + fragment_cloud_center(:,1) = impactors%rc(:,1) - rdistance(1) * impactors%bounce_unit(:) + else + fragment_cloud_center(:,1) = impactors%rc(:,1) + end if + fragment_cloud_center(:,2) = impactors%rc(:,2) + rdistance(2) * impactors%bounce_unit(:) + if (lhitandrun) then + fragment_cloud_radius(:) = impactors%radius(:) + else + fragment_cloud_radius(1) = .mag.(fragment_cloud_center(:,1) - impactors%rbimp(:)) + fragment_cloud_radius(2) = .mag.(fragment_cloud_center(:,2) - impactors%rbimp(:)) + end if + do concurrent(i = 1:nfrag, loverlap(i)) + if (i < 3) then + fragments%rc(:,i) = fragment_cloud_center(:,i) + else + ! Make a random cloud + call random_number(fragments%rc(:,i)) + + ! Make the fragment cloud symmertic about 0 + fragments%rc(:,i) = 2 *(fragments%rc(:,i) - 0.5_DP) + + j = fragments%origin_body(i) + + ! Scale the cloud size + fragments%rc(:,i) = fragment_cloud_radius(j) * fragments%rc(:,i) + + ! Shift to the cloud center coordinates + fragments%rc(:,i) = fragments%rc(:,i) + fragment_cloud_center(:,j) end if end do + + ! Check for any overlapping bodies. loverlap(:) = .false. do j = 1, nfrag do i = j + 1, nfrag - dis = norm2(frag%x_coll(:,j) - frag%x_coll(:,i)) - loverlap(i) = loverlap(i) .or. (dis <= (frag%radius(i) + frag%radius(j))) + dis = .mag.(fragments%rc(:,j) - fragments%rc(:,i)) + loverlap(i) = loverlap(i) .or. (dis <= (fragments%radius(i) + fragments%radius(j))) end do end do + rdistance(:) = rdistance(:) * collider%fail_scale end do - call fraggle_util_shift_vector_to_origin(frag%mass, frag%x_coll) - call frag%set_coordinate_system(colliders) - do i = 1, nfrag - frag%xb(:,i) = frag%x_coll(:,i) + frag%xbcom(:) + call collision_util_shift_vector_to_origin(fragments%mass, fragments%rc) + call collider%set_coordinate_system() + + do concurrent(i = 1:nfrag) + fragments%rb(:,i) = fragments%rc(:,i) + impactors%rbcom(:) end do - frag%xbcom(:) = 0.0_DP - do i = 1, nfrag - frag%xbcom(:) = frag%xbcom(:) + frag%mass(i) * frag%xb(:,i) + impactors%rbcom(:) = 0.0_DP + do concurrent(i = 1:nfrag) + impactors%rbcom(:) = impactors%rbcom(:) + fragments%mass(i) * fragments%rb(:,i) end do - frag%xbcom(:) = frag%xbcom(:) / frag%mtot + impactors%rbcom(:) = impactors%rbcom(:) / fragments%mtot end associate return end subroutine fraggle_generate_pos_vec - subroutine fraggle_generate_spins(frag, f_spin, lfailure) + module subroutine fraggle_generate_rot_vec(collider) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! - !! Calculates the spins of a collection of fragments such that they conserve angular momentum without blowing the fragment kinetic energy budget. - !! - !! A failure will trigger a restructuring of the fragments so we will try new values of the radial position distribution. + !! Calculates the spins of a collection of fragments such that they conserve angular momentum implicit none ! Arguments - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragment system object - real(DP), intent(in) :: f_spin !! Fraction of energy or momentum that goes into spin (whichever gives the lowest kinetic energy) - logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! + class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object ! Internals - real(DP), dimension(NDIM) :: L_remainder, rot_L, rot_ke - integer(I4B) :: i - character(len=STRMAX) :: message - - associate(nfrag => frag%nbody) - lfailure = .false. - - ! Start the first two bodies with the same rotation as the original two impactors, then distribute the remaining angular momentum among the rest - L_remainder(:) = frag%L_budget(:) - frag%rot(:,:) = 0.0_DP - - frag%ke_spin = 0.0_DP - do i = 1, nfrag - ! Convert a fraction (f_spin) of either the remaining angular momentum or kinetic energy budget into spin, whichever gives the smaller rotation so as not to blow any budgets - rot_ke(:) = sqrt(2 * f_spin * frag%ke_budget / (nfrag * frag%mass(i) * frag%radius(i)**2 * frag%Ip(3, i))) & - * L_remainder(:) / norm2(L_remainder(:)) - rot_L(:) = f_spin * L_remainder(:) / (nfrag * frag%mass(i) * frag%radius(i)**2 * frag%Ip(3, i)) - if (norm2(rot_ke) < norm2(rot_L)) then - frag%rot(:,i) = rot_ke(:) - else - frag%rot(:, i) = rot_L(:) - end if - frag%ke_spin = frag%ke_spin + frag%mass(i) * frag%Ip(3, i) * frag%radius(i)**2 & - * dot_product(frag%rot(:, i), frag%rot(:, i)) + real(DP), dimension(NDIM) :: Lbefore, Lafter, Lspin, rotdir + real(DP) :: v_init, v_final, mass_init, mass_final, rotmag + integer(I4B) :: i + + associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) + + ! Torque the first body based on the change in angular momentum betwen the pre- and post-impact system assuming a simple bounce + mass_init = impactors%mass(2) + mass_final = sum(fragments%mass(2:nfrag)) + v_init = .mag.(impactors%vb(:,2) - impactors%vb(:,1)) + v_final = sqrt(mass_init / mass_final * v_init**2 - 2 * impactors%Qloss / mass_final) + + Lbefore(:) = mass_init * (impactors%rb(:,2) - impactors%rb(:,1)) .cross. (impactors%vb(:,2) - impactors%vb(:,1)) + + Lafter(:) = mass_final * (impactors%rb(:,2) - impactors%rb(:,1)) .cross. (v_final * impactors%bounce_unit(:)) + Lspin(:) = impactors%Lspin(:,1) + (Lbefore(:) - Lafter(:)) + fragments%rot(:,1) = Lspin(:) / (fragments%mass(1) * fragments%radius(1)**2 * fragments%Ip(3,1)) + + ! Add in some random spin noise. The magnitude will be scaled by the before-after amount and the direction will be random + do concurrent(i = 2:nfrag) + call random_number(rotdir) + rotdir = rotdir - 0.5_DP + rotdir = .unit. rotdir + call random_number(rotmag) + rotmag = 0.01_DP * rotmag * .mag. (Lbefore(:) - Lafter(:)) / ((nfrag - 1) * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i)) + fragments%rot(:,i) = rotmag * rotdir end do - frag%ke_spin = 0.5_DP * frag%ke_spin - - lfailure = ((frag%ke_budget - frag%ke_spin - frag%ke_orbit) < 0.0_DP) - - if (lfailure) then - call io_log_one_message(FRAGGLE_LOG_OUT, " ") - call io_log_one_message(FRAGGLE_LOG_OUT, "Spin failure diagnostics") - write(message, *) frag%ke_budget - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_budget : " // trim(adjustl(message))) - write(message, *) frag%ke_spin - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_spin : " // trim(adjustl(message))) - write(message, *) frag%ke_orbit - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_orbit : " // trim(adjustl(message))) - write(message, *) frag%ke_budget - frag%ke_spin - frag%ke_orbit - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) - end if end associate return - end subroutine fraggle_generate_spins + end subroutine fraggle_generate_rot_vec - subroutine fraggle_generate_tan_vel(frag, lfailure) - !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Adjusts the tangential velocities and spins of a collection of fragments such that they conserve angular momentum without blowing the fragment kinetic energy budget. - !! This procedure works in several stages, with a goal to solve the angular and linear momentum constraints on the fragments, while still leaving a positive balance of - !! our fragment kinetic energy (frag%ke_budget) that we can put into the radial velocity distribution. - !! - !! The first thing we'll try to do is solve for the tangential velocities of the first 6 fragments, using angular and linear momentum as constraints and an initial - !! tangential velocity distribution for the remaining bodies (if there are any) that distributes their angular momentum equally between them. - !! If that doesn't work and we blow our kinetic energy budget, we will attempt to find a tangential velocity distribution that minimizes the kinetic energy while - !! conserving momentum. + module subroutine fraggle_generate_vel_vec(collider, lfailure) + !! Author: David A. Minton !! - !! A failure will trigger a restructuring of the fragments so we will try new values of the radial position distribution. + !! Generates an initial velocity distribution. For disruptions, the velocity magnitude is set to be + !! 2x the escape velocity of the colliding pair. For hit and runs the velocity magnitude is set to be + !! 2x the escape velocity of the smallest of the two bodies. implicit none ! Arguments - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragment system object - logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds + class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object + logical, intent(out) :: lfailure !! Did the velocity computation fail? ! Internals - integer(I4B) :: i - real(DP), parameter :: TOL_MIN = 1e-1_DP ! This doesn't have to be very accurate, as we really just want a tangential velocity distribution with less kinetic energy than our initial guess. - real(DP), parameter :: TOL_INIT = 1e-14_DP - real(DP), parameter :: VNOISE_MAG = 1e-3_DP !! Magnitude of the noise to apply to initial conditions to help minimizer find a solution in case of failure - integer(I4B), parameter :: MAXLOOP = 10 - real(DP) :: tol - real(DP), dimension(:), allocatable :: v_t_initial - real(DP), dimension(frag%nbody) :: kefrag, vnoise - type(lambda_obj_err) :: objective_function - real(DP), dimension(NDIM) :: Li, L_remainder, L_frag_tot - character(len=STRMAX) :: message - - associate(nfrag => frag%nbody) - lfailure = .false. - - allocate(v_t_initial, mold=frag%v_t_mag) - v_t_initial(:) = 0.0_DP - frag%v_coll(:,:) = 0.0_DP - - ! Next we will solve for the tangential component of the velocities that both conserves linear momentum and uses the remaining angular momentum not used in spin. - ! This will be done using a linear solver that solves for the tangential velocities of the first 6 fragments, constrained by the linear and angular momentum vectors, - ! which is embedded in a non-linear minimizer that will adjust the tangential velocities of the remaining i>6 fragments to minimize kinetic energy for a given momentum solution - ! The initial conditions fed to the minimizer for the fragments will be the remaining angular momentum distributed between the fragments. - call frag%get_ang_mtm() - L_remainder(:) = frag%L_budget(:) - frag%L_spin(:) - do i = 1, nfrag - v_t_initial(i) = norm2(L_remainder(:)) / ((nfrag - i + 1) * frag%mass(i) * norm2(frag%x_coll(:,i))) - Li(:) = frag%mass(i) * (frag%x_coll(:,i) .cross. (v_t_initial(i) * frag%v_t_unit(:, i))) - L_remainder(:) = L_remainder(:) - Li(:) - end do + integer(I4B) :: i, j, loop, try, istart, n, ndof + logical :: lhitandrun, lsupercat + real(DP), dimension(NDIM) :: vimp_unit, rimp, vrot, Lresidual, vshear, vunit + real(DP) :: vmag, vesc, rotmag, E_residual, ke_per_dof, ke_tot, E_residual_min + integer(I4B), dimension(collider%fragments%nbody) :: vsign + real(DP), dimension(collider%fragments%nbody) :: vscale, mass_vscale, ke_avail + integer(I4B), parameter :: MAXLOOP = 100 + integer(I4B), parameter :: MAXTRY = 100 + real(DP), parameter :: TOL = 1e-6 + class(collision_fragments(:)), allocatable :: fragments + + associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) + lhitandrun = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) + lsupercat = (impactors%regime == COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + + allocate(fragments, source=collider%fragments) + + ! The fragments will be divided into two "clouds" based on identified origin body. + ! These clouds will collectively travel like two impactors bouncing off of each other. + where(fragments%origin_body(:) == 1) + vsign(:) = -1 + elsewhere + vsign(:) = 1 + end where + + ! The minimum fragment velocity will be set by the escape velocity + if (lhitandrun) then + vesc = sqrt(2 * impactors%Gmass(2) / impactors%radius(2)) + else + vesc = sqrt(2 * sum(impactors%Gmass(:)) / sum(impactors%radius(:))) + end if - ! Find the local kinetic energy minimum for the system that conserves linear and angular momentum - objective_function = lambda_obj(tangential_objective_function, lfailure) - - tol = TOL_INIT - do while(tol < TOL_MIN) - frag%v_t_mag(7:nfrag) = util_minimize_bfgs(objective_function, nfrag-6, v_t_initial(7:nfrag), tol, MAXLOOP, lfailure) - ! Now that the KE-minimized values of the i>6 fragments are found, calculate the momentum-conserving solution for tangential velociteis - v_t_initial(7:nfrag) = frag%v_t_mag(7:nfrag) - if (.not.lfailure) exit - tol = tol * 2_DP ! Keep increasing the tolerance until we converge on a solution - call random_number(vnoise(1:nfrag)) ! Adding a bit of noise to the initial conditions helps it find a solution more often - vnoise(:) = 1.0_DP + VNOISE_MAG * (2 * vnoise(:) - 1._DP) - v_t_initial(:) = v_t_initial(:) * vnoise(:) + ! Scale the magnitude of the velocity by the distance from the impact point + ! This will reduce the chances of fragments colliding with each other immediately, and is more physically correct + do concurrent(i = 1:nfrag) + rimp(:) = fragments%rc(:,i) - impactors%rbimp(:) + vscale(i) = .mag. rimp(:) / (.mag. (impactors%rb(:,2) - impactors%rb(:,1))) end do - frag%v_t_mag(1:nfrag) = solve_fragment_tan_vel(v_t_mag_input=v_t_initial(7:nfrag), lfailure=lfailure) + vscale(:) = vscale(:)/minval(vscale(:)) - ! Perform one final shift of the radial velocity vectors to align with the center of mass of the collisional system (the origin) - frag%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(frag%v_r_mag(1:nfrag), frag%v_r_unit(:,1:nfrag), frag%v_t_mag(1:nfrag), & - frag%v_t_unit(:,1:nfrag), frag%mass(1:nfrag), frag%vbcom(:)) - do concurrent (i = 1:nfrag) - frag%v_coll(:,i) = frag%vb(:,i) - frag%vbcom(:) - end do + ! Give the fragment velocities a random value that is scaled with fragment mass + call random_number(mass_vscale) + mass_vscale(:) = (mass_vscale(:) + 1.0_DP) / 2 + mass_vscale(:) = mass_vscale(:) * (fragments%mtot / fragments%mass(:))**(0.125_DP) ! The power is arbitrary. It just gives the velocity a small mass dependence + mass_vscale(:) = mass_vscale(:) / minval(mass_vscale(:)) - ! Now do a kinetic energy budget check to make sure we are still within the budget. - kefrag = 0.0_DP + ! Set the velocities of all fragments using all of the scale factors determined above do concurrent(i = 1:nfrag) - kefrag(i) = frag%mass(i) * dot_product(frag%vb(:, i), frag%vb(:, i)) + j = fragments%origin_body(i) + vrot(:) = impactors%rot(:,j) .cross. (fragments%rc(:,i) - impactors%rc(:,j)) + if (lhitandrun) then + if (i == 1) then + fragments%vc(:,1) = impactors%vc(:,1) + else + vmag = .mag.impactors%vc(:,2) / (maxval(mass_vscale(:) * maxval(vscale(:)))) + fragments%vc(:,i) = vmag * mass_vscale(i) * vscale(i) * impactors%bounce_unit(:) * vsign(i) + vrot(:) + end if + else + ! Add more velocity dispersion to disruptions vs hit and runs. + vmag = vesc * vscale(i) * mass_vscale(i) + rimp(:) = fragments%rc(:,i) - impactors%rbimp(:) + vimp_unit(:) = .unit. rimp(:) + fragments%vc(:,i) = vmag * (impactors%bounce_unit(:) + vimp_unit(:)) * vsign(i) + vrot(:) + end if end do - frag%ke_orbit = 0.5_DP * sum(kefrag(:)) - - ! If we are over the energy budget, flag this as a failure so we can try again - lfailure = ((frag%ke_budget - frag%ke_spin - frag%ke_orbit) < 0.0_DP) - if (lfailure) then - call io_log_one_message(FRAGGLE_LOG_OUT, " ") - call io_log_one_message(FRAGGLE_LOG_OUT, "Tangential velocity failure diagnostics") - call frag%get_ang_mtm() - L_frag_tot = frag%L_spin(:) + frag%L_orbit(:) - write(message, *) .mag.(frag%L_budget(:) - L_frag_tot(:)) / (.mag.frag%Ltot_before(:)) - call io_log_one_message(FRAGGLE_LOG_OUT, "|L_remainder| : " // trim(adjustl(message))) - write(message, *) frag%ke_budget - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_budget : " // trim(adjustl(message))) - write(message, *) frag%ke_spin - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_spin : " // trim(adjustl(message))) - write(message, *) frag%ke_orbit - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_tangential : " // trim(adjustl(message))) - write(message, *) frag%ke_budget - frag%ke_spin - frag%ke_orbit - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_radial : " // trim(adjustl(message))) - end if - end associate - - return - contains - function solve_fragment_tan_vel(lfailure, v_t_mag_input) result(v_t_mag_output) - !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Adjusts the positions, velocities, and spins of a collection of fragments such that they conserve angular momentum - implicit none - ! Arguments - logical, intent(out) :: lfailure !! Error flag - real(DP), dimension(:), optional, intent(in) :: v_t_mag_input !! Unknown tangential velocities for fragments 7:nfrag - ! Internals - integer(I4B) :: i - ! Result - real(DP), dimension(:), allocatable :: v_t_mag_output - - real(DP), dimension(2 * NDIM, 2 * NDIM) :: A ! LHS of linear equation used to solve for momentum constraint in Gauss elimination code - real(DP), dimension(2 * NDIM) :: b ! RHS of linear equation used to solve for momentum constraint in Gauss elimination code - real(DP), dimension(NDIM) :: L_lin_others, L_orb_others, L, vtmp - - associate(nfrag => frag%nbody) - lfailure = .false. - ! We have 6 constraint equations (2 vector constraints in 3 dimensions each) - ! The first 3 are that the linear momentum of the fragments is zero with respect to the collisional barycenter - ! The second 3 are that the sum of the angular momentum of the fragments is conserved from the pre-impact state - L_lin_others(:) = 0.0_DP - L_orb_others(:) = 0.0_DP - do i = 1, nfrag - if (i <= 2 * NDIM) then ! The tangential velocities of the first set of bodies will be the unknowns we will solve for to satisfy the constraints - A(1:3, i) = frag%mass(i) * frag%v_t_unit(:, i) - A(4:6, i) = frag%mass(i) * frag%rmag(i) * (frag%v_r_unit(:, i) .cross. frag%v_t_unit(:, i)) - else if (present(v_t_mag_input)) then - vtmp(:) = v_t_mag_input(i - 6) * frag%v_t_unit(:, i) - L_lin_others(:) = L_lin_others(:) + frag%mass(i) * vtmp(:) - L(:) = frag%mass(i) * (frag%x_coll(:, i) .cross. vtmp(:)) - L_orb_others(:) = L_orb_others(:) + L(:) + if (lhitandrun) then + istart = 2 + else + istart = 1 + end if + call fragments%set_coordinate_system() + E_residual_min = -huge(1.0_DP) + outer: do try = 1, MAXTRY + do loop = 1, MAXLOOP + call fragments%get_energy() + E_residual = fragments%E_budget - (fragments%ke_orbit_tot + fragments%ke_spin_tot + fragments%pe + fragments%be) + if ((abs(E_residual) < abs(E_residual_min)) .or. ((E_residual >= 0.0_DP) .and. (E_residual_min < 0.0_DP))) then ! This is our best case so far. Save it for posterity + if (allocated(collider%fragments)) deallocate(collider%fragments) + allocate(collider%fragments, source=fragments) + E_residual_min = E_residual + if ((E_residual > 0.0_DP) .and. (E_residual < TOL * fragments%E_budget)) exit outer + end if + ! Make sure we don't take away too much orbital kinetic energy, otherwise the fragment can't escape + ke_avail(:) = fragments%ke_orbit(:) - impactors%Gmass(1)*impactors%mass(2)/fragments%rmag(:) + ke_tot = 0.0_DP + ke_per_dof = -E_residual + do i = 1, 2*(nfrag - istart + 1) + n = count(ke_avail(istart:nfrag) > -E_residual/i) + if (E_residual < 0.0_DP) n = n + count(fragments%ke_spin(istart:nfrag) > -E_residual/i) + if (abs(n * ke_per_dof) > ke_tot) then + ke_per_dof = -E_residual/i + ke_tot = n * ke_per_dof + ndof = i + if (abs(ke_tot) > abs(E_residual)) then + ke_tot = -E_residual + ke_per_dof = ke_tot/n + exit + end if end if end do - b(1:3) = -L_lin_others(:) - b(4:6) = frag%L_budget(:) - frag%L_spin(:) - L_orb_others(:) - allocate(v_t_mag_output(nfrag)) - v_t_mag_output(1:6) = util_solve_linear_system(A, b, 6, lfailure) - if (present(v_t_mag_input)) v_t_mag_output(7:nfrag) = v_t_mag_input(:) - end associate - return - end function solve_fragment_tan_vel - - - function tangential_objective_function(v_t_mag_input, lfailure) result(fval) - !! Author: David A. Minton - !! - !! Objective function for evaluating how close our fragment velocities get to minimizing KE error from our required value - implicit none - ! Arguments - real(DP), dimension(:), intent(in) :: v_t_mag_input !! Unknown tangential component of velocity vector set previously by angular momentum constraint - logical, intent(out) :: lfailure !! Error flag - ! Result - real(DP) :: fval - ! Internals - integer(I4B) :: i - real(DP), dimension(NDIM,frag%nbody) :: v_shift - real(DP), dimension(frag%nbody) :: v_t_new, kearr - real(DP) :: keo - - associate(nfrag => frag%nbody) - lfailure = .false. - - v_t_new(:) = solve_fragment_tan_vel(v_t_mag_input=v_t_mag_input(:), lfailure=lfailure) - v_shift(:,:) = fraggle_util_vmag_to_vb(frag%v_r_mag, frag%v_r_unit, v_t_new, frag%v_t_unit, frag%mass, frag%vbcom) - - kearr = 0.0_DP - do concurrent(i = 1:nfrag) - kearr(i) = frag%mass(i) * dot_product(v_shift(:, i), v_shift(:, i)) + do concurrent(i = istart:nfrag, ke_avail(i) > ke_per_dof) + vmag = max(fragments%vmag(i)**2 - 2*ke_per_dof/fragments%mass(i),vesc**2) + fragments%vmag(i) = sqrt(vmag) + fragments%vc(:,i) = fragments%vmag(i) * .unit.fragments%vc(:,i) + end do + do concurrent(i = istart:nfrag, fragments%ke_spin(i) > ke_per_dof) + rotmag = fragments%rotmag(i)**2 - 2*ke_per_dof/(fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i)) + rotmag = max(rotmag, 0.0_DP) + fragments%rotmag(i) = sqrt(rotmag) + fragments%rot(:,i) = fragments%rotmag(i) * .unit.fragments%rot(:,i) end do - keo = 0.5_DP * sum(kearr(:)) - fval = keo - lfailure = .false. - end associate - return - end function tangential_objective_function + call fragments%set_coordinate_system() + if (lsupercat) then + ! Put some of the residual angular momentum into velocity shear. Not too much, or we get some weird trajectories + call fragments%get_angular_momentum() + Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit_tot(:) + fragments%Lspin_tot(:)) + do concurrent(i = istart:nfrag) + vunit(:) = .unit. (Lresidual(:) .cross. fragments%r_unit(:,i)) + vshear(:) = vunit(:) * (.mag.Lresidual(:) / ((nfrag-istart+1)*fragments%mass(i) * fragments%rmag(i))) + fragments%vc(:,i) = fragments%vc(:,i) + vshear(:) + end do + end if + ! Check for any residual angular momentum, and if there is any, put it into spin + call fragments%get_angular_momentum() + Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit_tot(:) + fragments%Lspin_tot(:)) + do concurrent(i = 1:nfrag) + fragments%Lspin(:,i) = fragments%Lspin(:,i) + Lresidual(:) / nfrag + fragments%rot(:,i) = fragments%Lspin(:,i) / (fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(:,i)) + end do - end subroutine fraggle_generate_tan_vel + call fragments%get_angular_momentum() + Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit_tot(:) + fragments%Lspin_tot(:)) + end do + ! We didn't converge. Try another configuration and see if we get a better result + call fraggle_generate_pos_vec(collider) + call fraggle_generate_rot_vec(collider) + collider%fail_scale = collider%fail_scale*1.01_DP + end do outer + lfailure = E_residual < 0.0_DP - subroutine fraggle_generate_rad_vel(frag, lfailure) - !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! - !! Adjust the fragment velocities to set the fragment orbital kinetic energy. This will minimize the difference between the fragment kinetic energy and the energy budget - implicit none - ! Arguments - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragment system object - logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! - ! Internals - real(DP), parameter :: TOL_MIN = FRAGGLE_ETOL ! This needs to be more accurate than the tangential step, as we are trying to minimize the total residual energy - real(DP), parameter :: TOL_INIT = 1e-14_DP - real(DP), parameter :: VNOISE_MAG = 1e-10_DP !! Magnitude of the noise to apply to initial conditions to help minimizer find a solution in case of failure - integer(I4B), parameter :: MAXLOOP = 100 - real(DP) :: ke_radial, tol - integer(I4B) :: i - real(DP), dimension(:), allocatable :: v_r_initial - real(DP), dimension(frag%nbody) :: vnoise - type(lambda_obj) :: objective_function - character(len=STRMAX) :: message - - associate(nfrag => frag%nbody) - ! Set the "target" ke for the radial component - ke_radial = frag%ke_budget - frag%ke_spin - frag%ke_orbit - - allocate(v_r_initial, source=frag%v_r_mag) - ! Initialize radial velocity magnitudes with a random value that related to equipartition of kinetic energy with some noise - call random_number(vnoise(1:nfrag)) - vnoise(:) = 1.0_DP + VNOISE_MAG * (2 * vnoise(:) - 1.0_DP) - v_r_initial(1:nfrag) = sqrt(abs(2 * ke_radial) / (frag%mass(1:nfrag) * nfrag)) * vnoise(1:nfrag) - - ! Initialize the lambda function using a structure constructor that calls the init method - ! Minimize the ke objective function using the BFGS optimizer - objective_function = lambda_obj(radial_objective_function) - tol = TOL_INIT - do while(tol < TOL_MIN) - frag%v_r_mag = util_minimize_bfgs(objective_function, nfrag, v_r_initial, tol, MAXLOOP, lfailure) - if (.not.lfailure) exit - tol = tol * 2 ! Keep increasing the tolerance until we converge on a solution - v_r_initial(:) = frag%v_r_mag(:) - call random_number(vnoise(1:nfrag)) ! Adding a bit of noise to the initial conditions helps it find a solution more often - vnoise(:) = 1.0_DP + VNOISE_MAG * (2 * vnoise(:) - 1._DP) - v_r_initial(:) = v_r_initial(:) * vnoise(:) + do concurrent(i = 1:nfrag) + fragments%vb(:,i) = fragments%vc(:,i) + impactors%vbcom(:) end do - - ! Shift the radial velocity vectors to align with the center of mass of the collisional system (the origin) - frag%ke_orbit = 0.0_DP - frag%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(frag%v_r_mag(1:nfrag), frag%v_r_unit(:,1:nfrag), & - frag%v_t_mag(1:nfrag), frag%v_t_unit(:,1:nfrag), frag%mass(1:nfrag), frag%vbcom(:)) - do i = 1, nfrag - frag%v_coll(:, i) = frag%vb(:, i) - frag%vbcom(:) - frag%ke_orbit = frag%ke_orbit + frag%mass(i) * dot_product(frag%vb(:, i), frag%vb(:, i)) + + impactors%vbcom(:) = 0.0_DP + do concurrent(i = 1:nfrag) + impactors%vbcom(:) = impactors%vbcom(:) + fragments%mass(i) * fragments%vb(:,i) end do - frag%ke_orbit = 0.5_DP * frag%ke_orbit - - lfailure = abs((frag%ke_budget - (frag%ke_orbit + frag%ke_spin)) / frag%ke_budget) > FRAGGLE_ETOL - if (lfailure) then - call io_log_one_message(FRAGGLE_LOG_OUT, " ") - call io_log_one_message(FRAGGLE_LOG_OUT, "Radial velocity failure diagnostics") - write(message, *) frag%ke_budget - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_budget : " // trim(adjustl(message))) - write(message, *) frag%ke_spin - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_spin : " // trim(adjustl(message))) - write(message, *) frag%ke_orbit - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_orbit : " // trim(adjustl(message))) - write(message, *) frag%ke_budget - (frag%ke_orbit + frag%ke_spin) - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) - end if + impactors%vbcom(:) = impactors%vbcom(:) / fragments%mtot end associate return + end subroutine fraggle_generate_vel_vec - contains - function radial_objective_function(v_r_mag_input) result(fval) - !! Author: David A. Minton - !! - !! Objective function for evaluating how close our fragment velocities get to minimizing KE error from our required value - implicit none - ! Arguments - real(DP), dimension(:), intent(in) :: v_r_mag_input !! Unknown radial component of fragment velocity vector - ! Result - real(DP) :: fval !! The objective function result, which is the square of the difference between the calculated fragment kinetic energy and our target - !! Minimizing this brings us closer to our objective - ! Internals - integer(I4B) :: i - real(DP), dimension(:,:), allocatable :: v_shift - real(DP), dimension(frag%nbody) :: kearr - real(DP) :: keo, ke_radial, rotmag2, vmag2 - - allocate(v_shift, mold=frag%vb) - v_shift(:,:) = fraggle_util_vmag_to_vb(v_r_mag_input, frag%v_r_unit, frag%v_t_mag, frag%v_t_unit, frag%mass, frag%vbcom) - !$omp do simd firstprivate(frag) - do i = 1,frag%nbody - rotmag2 = frag%rot(1,i)**2 + frag%rot(2,i)**2 + frag%rot(3,i)**2 - vmag2 = v_shift(1,i)**2 + v_shift(2,i)**2 + v_shift(3,i)**2 - kearr(i) = frag%mass(i) * (frag%Ip(3, i) * frag%radius(i)**2 * rotmag2 + vmag2) - end do - !$omp end do simd - keo = 2 * frag%ke_budget - sum(kearr(:)) - ke_radial = frag%ke_budget - frag%ke_orbit - frag%ke_spin - ! The following ensures that fval = 0 is a local minimum, which is what the BFGS method is searching for - fval = (keo / (2 * ke_radial))**2 - - return - end function radial_objective_function - - end subroutine fraggle_generate_rad_vel end submodule s_fraggle_generate diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 deleted file mode 100644 index b1a60a25b..000000000 --- a/src/fraggle/fraggle_io.f90 +++ /dev/null @@ -1,219 +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. - -submodule(fraggle_classes) s_fraggle_io - use swiftest - -contains - - module subroutine fraggle_io_log_generate(frag) - !! author: David A. Minton - !! - !! Writes a log of the results of the fragment generation - implicit none - ! Arguments - class(fraggle_fragments), intent(in) :: frag - ! Internals - integer(I4B) :: i - character(STRMAX) :: errmsg - character(len=*), parameter :: fmtlabel = "(A14,10(ES11.4,1X,:))" - - open(unit=LUN, file=FRAGGLE_LOG_OUT, status = 'OLD', position = 'APPEND', form = 'FORMATTED', err = 667, iomsg = errmsg) - write(LUN, *, err = 667, iomsg = errmsg) - write(LUN, *) "--------------------------------------------------------------------" - write(LUN, *) " Fraggle fragment generation results" - write(LUN, *) "--------------------------------------------------------------------" - write(LUN, "(' dL_tot should be very small' )") - write(LUN,fmtlabel) ' dL_tot |', (.mag.(frag%Ltot_after(:) - frag%Ltot_before(:))) / (.mag.frag%Ltot_before(:)) - write(LUN, "(' dE_tot should be negative and equal to Qloss' )") - write(LUN,fmtlabel) ' dE_tot |', (frag%Etot_after - frag%Etot_before) / abs(frag%Etot_before) - write(LUN,fmtlabel) ' Qloss |', -frag%Qloss / abs(frag%Etot_before) - write(LUN,fmtlabel) ' dE - Qloss |', (frag%Etot_after - frag%Etot_before + frag%Qloss) / abs(frag%Etot_before) - write(LUN, "(' -------------------------------------------------------------------------------------')") - write(LUN, *) "Individual fragment values (collisional system natural units)" - write(LUN, *) "mass" - do i = 1, frag%nbody - write(LUN, *) i, frag%mass(i) - end do - write(LUN, *) "x_coll" - do i = 1, frag%nbody - write(LUN, *) i, frag%x_coll(:,i) - end do - write(LUN, *) "v_coll" - do i = 1, frag%nbody - write(LUN, *) i, frag%v_coll(:,i) - end do - write(LUN, *) "xb" - do i = 1, frag%nbody - write(LUN, *) i, frag%xb(:,i) - end do - write(LUN, *) "vb" - do i = 1, frag%nbody - write(LUN, *) i, frag%vb(:,i) - end do - write(LUN, *) "rot" - do i = 1, frag%nbody - write(LUN, *) i, frag%rot(:,i) - end do - - close(LUN) - - return - 667 continue - write(*,*) "Error writing Fraggle message to log file: " // trim(adjustl(errmsg)) - end subroutine fraggle_io_log_generate - - - module subroutine fraggle_io_log_pl(pl, param) - !! author: David A. Minton - !! - !! Writes a single message to the fraggle log file - implicit none - ! Arguments - class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object (only the new bodies generated in a collision) - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters - ! Internals - integer(I4B) :: i - character(STRMAX) :: errmsg - - open(unit=LUN, file=FRAGGLE_LOG_OUT, status = 'OLD', position = 'APPEND', form = 'FORMATTED', err = 667, iomsg = errmsg) - write(LUN, *, err = 667, iomsg = errmsg) - - write(LUN, *) "--------------------------------------------------------------------" - write(LUN, *) " Fraggle fragment final body properties" - write(LUN, *) "--------------------------------------------------------------------" - write(LUN, *) "id, name" - do i = 1, pl%nbody - write(LUN, *) i, pl%id(i), pl%info(i)%name - end do - write(LUN, *) "mass, Gmass" - do i = 1, pl%nbody - write(LUN, *) i, pl%mass(i), pl%Gmass(i) - end do - write(LUN, *) "radius" - do i = 1, pl%nbody - write(LUN, *) i, pl%radius(i) - end do - write(LUN, *) "xb" - do i = 1, pl%nbody - write(LUN, *) i, pl%xb(:,i) - end do - write(LUN, *) "vb" - do i = 1, pl%nbody - write(LUN, *) i, pl%vb(:,i) - end do - write(LUN, *) "xh" - do i = 1, pl%nbody - write(LUN, *) i, pl%xh(:,i) - end do - write(LUN, *) "vh" - do i = 1, pl%nbody - write(LUN, *) i, pl%vh(:,i) - end do - - if (param%lrotation) then - write(LUN, *) "rot" - do i = 1, pl%nbody - write(LUN, *) i, pl%rot(:,i) - end do - write(LUN, *) "Ip" - do i = 1, pl%nbody - write(LUN, *) i, pl%Ip(:,i) - end do - end if - - ! if (param%ltides) then - ! write(LUN, *) "Q" - ! do i = 1, pl%nbody - ! write(LUN, *) i, pl%Q(i) - ! end do - ! write(LUN, *) "k2" - ! do i = 1, pl%nbody - ! write(LUN, *) i, pl%k2(i) - ! end do - ! write(LUN, *) "tlag" - ! do i = 1, pl%nbody - ! write(LUN, *) i, pl%tlag(i) - ! end do - ! end if - - close(LUN) - - return - 667 continue - write(*,*) "Error writing Fraggle message to log file: " // trim(adjustl(errmsg)) - end subroutine fraggle_io_log_pl - - - module subroutine fraggle_io_log_regime(colliders, frag) - !! author: David A. Minton - !! - !! Writes a log of the results of the collisional regime determination - implicit none - ! Arguments - class(fraggle_colliders), intent(in) :: colliders !! Fraggle collider system object - class(fraggle_fragments), intent(in) :: frag !! Fraggle fragment object - ! Internals - character(STRMAX) :: errmsg - - open(unit=LUN, file=FRAGGLE_LOG_OUT, status = 'OLD', position = 'APPEND', form = 'FORMATTED', err = 667, iomsg = errmsg) - write(LUN, *, err = 667, iomsg = errmsg) - write(LUN, *) "--------------------------------------------------------------------" - write(LUN, *) " Fraggle collisional regime determination results" - write(LUN, *) "--------------------------------------------------------------------" - write(LUN, *) "----------------------- Collider information -----------------------" - write(LUN, *) "True number of colliders : ",colliders%ncoll - write(LUN, *) "Index list of true colliders : ",colliders%idx(1:colliders%ncoll) - write(LUN, *) "-------------------- Two-body equialent values ---------------------" - write(LUN, *) "mass1 : ",colliders%mass(1) - write(LUN, *) "radius1 : ",colliders%radius(1) - write(LUN, *) "xb1 : ",colliders%xb(:,1) - write(LUN, *) "vb1 : ",colliders%vb(:,1) - write(LUN, *) "rot1 : ",colliders%rot(:,1) - write(LUN, *) "Ip1 : ",colliders%Ip(:,1) - write(LUN, *) "L_spin1 : ",colliders%L_spin(:,1) - write(LUN, *) "L_orbit1 : ",colliders%L_orbit(:,1) - write(LUN, *) "mass2 : ",colliders%mass(2) - write(LUN, *) "radius2 : ",colliders%radius(2) - write(LUN, *) "xb2 : ",colliders%xb(:,2) - write(LUN, *) "vb2 : ",colliders%vb(:,2) - write(LUN, *) "rot2 : ",colliders%rot(:,2) - write(LUN, *) "Ip2 : ",colliders%Ip(:,2) - write(LUN, *) "L_spin2 : ",colliders%L_spin(:,2) - write(LUN, *) "L_orbit2 : ",colliders%L_orbit(:,2) - write(LUN, *) "------------------------------ Regime -----------------------------" - select case(frag%regime) - case(COLLRESOLVE_REGIME_MERGE) - write(LUN, *) "Merge" - case(COLLRESOLVE_REGIME_DISRUPTION) - write(LUN, *) "Disruption" - case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - write(LUN, *) "Supercatastrophic disruption" - case(COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - write(LUN, *) "Graze and merge" - case(COLLRESOLVE_REGIME_HIT_AND_RUN) - write(LUN, *) "Hit and run" - end select - write(LUN, *) "----------------------- Fragment information ----------------------" - write(LUN, *) "Total mass of fragments : ", frag%mtot - write(LUN, *) "Largest fragment mass : ", frag%mass_dist(1) - write(LUN, *) "Second-largest fragment mass : ", frag%mass_dist(2) - write(LUN, *) "Remaining fragment mass : ", frag%mass_dist(3) - write(LUN, *) "Center of mass position : ", frag%xbcom(:) - write(LUN, *) "Center of mass velocity : ", frag%vbcom(:) - write(LUN, *) "Energy loss : ", frag%Qloss - write(LUN, *) "--------------------------------------------------------------------" - close(LUN) - - return - 667 continue - write(*,*) "Error writing Fraggle regime information to log file: " // trim(adjustl(errmsg)) - end subroutine fraggle_io_log_regime - -end submodule s_fraggle_io \ No newline at end of file diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 new file mode 100644 index 000000000..b50aa3ac3 --- /dev/null +++ b/src/fraggle/fraggle_module.f90 @@ -0,0 +1,169 @@ +!! 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. + +module fraggle + !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Definition of classes and methods specific to Fraggle: *Fragment* *g*eneration that conserves angular momentum (*L*) and energy (*E*) + use swiftest + implicit none + public + + !> Class definition for the variables that describe a collection of fragments by Fraggle barycentric coordinates + type, extends(collision_fragments) :: fraggle_fragments + contains + + procedure :: reset => fraggle_util_reset_fragments !! 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) + final :: fraggle_final_fragments !! Finalizer will deallocate all allocatables + end type fraggle_fragments + + + type, extends(collision_basic) :: collision_fraggle + ! Scale factors used to scale dimensioned quantities to a more "natural" system where important quantities (like kinetic energy, momentum) are of order ~1 + real(DP) :: dscale = 1.0_DP !! Distance dimension scale factor + real(DP) :: mscale = 1.0_DP !! Mass scale factor + real(DP) :: tscale = 1.0_DP !! Time scale factor + real(DP) :: vscale = 1.0_DP !! Velocity scale factor (a convenience unit that is derived from dscale and tscale) + real(DP) :: Escale = 1.0_DP !! Energy scale factor (a convenience unit that is derived from dscale, tscale, and mscale) + real(DP) :: Lscale = 1.0_DP !! Angular momentum scale factor (a convenience unit that is derived from dscale, tscale, and mscale) + real(DP) :: fail_scale !! Scale factor to apply to distance values in the position model when overlaps occur. + contains + procedure :: disrupt => fraggle_generate_disrupt !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. + procedure :: generate => fraggle_generate !! A simple disruption models that does not constrain energy loss in collisions + procedure :: hitandrun => fraggle_generate_hitandrun + procedure :: set_mass_dist => fraggle_util_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type + procedure :: set_natural_scale => fraggle_util_set_natural_scale_factors !! Scales dimenional quantities to ~O(1) with respect to the collisional system. + procedure :: set_original_scale => fraggle_util_set_original_scale_factors !! Restores dimenional quantities back to the original system units + procedure :: setup_fragments => fraggle_util_setup_fragments_system !! Initializer for the fragments of the collision system. + procedure :: reset => fraggle_util_reset_system !! Deallocates all allocatables + final :: fraggle_final_system !! Finalizer will deallocate all allocatables + end type collision_fraggle + + interface + + + module subroutine fraggle_generate(self, nbody_system, param, t) + implicit none + class(collision_fraggle), intent(inout) :: self !! Fraggle fragment system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + end subroutine fraggle_generate + + module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailure) + implicit none + class(collision_fraggle), intent(inout) :: self !! Fraggle system object the outputs will be the fragmentation + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Time of collision + logical, optional, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? + end subroutine fraggle_generate_disrupt + + module subroutine fraggle_generate_hitandrun(self, nbody_system, param, t) + implicit none + class(collision_fraggle), intent(inout) :: self !! Collision system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + end subroutine fraggle_generate_hitandrun + + module subroutine fraggle_generate_pos_vec(collider) + implicit none + class(collision_fraggle), intent(inout) :: collider !! Fraggle ollision system object + end subroutine fraggle_generate_pos_vec + + module subroutine fraggle_generate_rot_vec(collider) + implicit none + class(collision_fraggle), intent(inout) :: collider !! Collision system object + end subroutine fraggle_generate_rot_vec + + module subroutine fraggle_generate_vel_vec(collider, lfailure) + implicit none + class(collision_fraggle), intent(inout) :: collider !! Collision system object + logical, intent(out) :: lfailure !! Did the velocity computation fail? + end subroutine fraggle_generate_vel_vec + + module subroutine fraggle_util_setup_fragments_system(self, nfrag) + implicit none + class(collision_fraggle), intent(inout) :: self !! Encounter collision system object + integer(I4B), intent(in) :: nfrag !! Number of fragments to create + end subroutine fraggle_util_setup_fragments_system + + module subroutine fraggle_util_reset_fragments(self) + implicit none + class(fraggle_fragments(*)), intent(inout) :: self + end subroutine fraggle_util_reset_fragments + + module subroutine fraggle_util_reset_system(self) + implicit none + class(collision_fraggle), intent(inout) :: self !! Collision system object + end subroutine fraggle_util_reset_system + + module subroutine fraggle_util_set_mass_dist(self, param) + implicit none + class(collision_fraggle), intent(inout) :: self !! Fraggle collision object + class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + end subroutine fraggle_util_set_mass_dist + + module subroutine fraggle_util_set_natural_scale_factors(self) + implicit none + class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object + end subroutine fraggle_util_set_natural_scale_factors + + module subroutine fraggle_util_set_original_scale_factors(self) + implicit none + class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object + end subroutine fraggle_util_set_original_scale_factors + + end interface + + contains + + subroutine fraggle_final_fragments(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(fraggle_fragments(*)), intent(inout) :: self !! Fraggle encountar storage object + + if (allocated(self%info)) deallocate(self%info) + + return + end subroutine fraggle_final_fragments + + + subroutine fraggle_final_impactors(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_impactors), intent(inout) :: self !! Fraggle impactors object + call self%reset() + return + end subroutine fraggle_final_impactors + + + subroutine fraggle_final_system(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_fraggle), intent(inout) :: self !! Collision impactors storage object + + call self%reset() + if (allocated(self%impactors)) deallocate(self%impactors) + if (allocated(self%fragments)) deallocate(self%fragments) + + return + end subroutine fraggle_final_system + +end module fraggle \ No newline at end of file diff --git a/src/fraggle/fraggle_placeholder.f90 b/src/fraggle/fraggle_placeholder.f90 deleted file mode 100644 index 35d5ea960..000000000 --- a/src/fraggle/fraggle_placeholder.f90 +++ /dev/null @@ -1,53 +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. - -submodule(fraggle_classes) s_fraggle_placeholder - use swiftest - -contains - - !> The following interfaces are placeholders intended to satisfy the required abstract methods given by the parent class - module subroutine fraggle_placeholder_accel(self, system, param, t, lbeg) - implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(swiftest_nbody_system), intent(inout) :: 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 - write(*,*) "The type-bound procedure 'accel' is not defined for type fraggle_fragments" - return - end subroutine fraggle_placeholder_accel - - module subroutine fraggle_placeholder_kick(self, system, param, t, dt, lbeg) - implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(swiftest_nbody_system), intent(inout) :: 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. - - write(*,*) "The type-bound procedure 'kick' is not defined for type fraggle_fragments" - return - end subroutine fraggle_placeholder_kick - - module subroutine fraggle_placeholder_step(self, system, param, t, dt) - implicit none - class(fraggle_fragments), intent(inout) :: self !! Swiftest body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest 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 - - write(*,*) "The type-bound procedure 'step' is not defined for type fraggle_fragments" - return - end subroutine fraggle_placeholder_step - - -end submodule s_fraggle_placeholder \ No newline at end of file diff --git a/src/fraggle/fraggle_set.f90 b/src/fraggle/fraggle_set.f90 deleted file mode 100644 index 6f61b989c..000000000 --- a/src/fraggle/fraggle_set.f90 +++ /dev/null @@ -1,317 +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. - -submodule(fraggle_classes) s_fraggle_set - use swiftest -contains - - module subroutine fraggle_set_budgets_fragments(self) - !! author: David A. Minton - !! - !! Sets the energy and momentum budgets of the fragments based on the collider values and the before/after values of energy and momentum - implicit none - ! Arguments - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - ! Internals - real(DP) :: dEtot - real(DP), dimension(NDIM) :: dL - - associate(frag => self) - - dEtot = frag%Etot_after - frag%Etot_before - dL(:) = frag%Ltot_after(:) - frag%Ltot_before(:) - - frag%L_budget(:) = -dL(:) - frag%ke_budget = -(dEtot - 0.5_DP * frag%mtot * dot_product(frag%vbcom(:), frag%vbcom(:))) - frag%Qloss - - end associate - return - end subroutine fraggle_set_budgets_fragments - - - module subroutine fraggle_set_mass_dist_fragments(self, colliders, param) - !! author: David A. Minton - !! - !! Sets the mass of fragments based on the mass distribution returned by the regime calculation. - !! This subroutine must be run after the the setup routine has been run on the fragments - !! - implicit none - ! Arguments - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object - class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters - ! Internals - integer(I4B) :: i, jproj, jtarg, nfrag, istart - real(DP), dimension(2) :: volume - real(DP), dimension(NDIM) :: Ip_avg - real(DP) :: mfrag, mremaining, min_mfrag - real(DP), parameter :: BETA = 2.85_DP - integer(I4B), parameter :: NFRAGMAX = 100 !! Maximum number of fragments that can be generated - integer(I4B), parameter :: NFRAGMIN = 7 !! Minimum number of fragments that can be generated (set by the fraggle_generate algorithm for constraining momentum and energy) - integer(I4B), parameter :: NFRAG_SIZE_MULTIPLIER = 3 !! Log-space scale factor that scales the number of fragments by the collisional system mass - integer(I4B), parameter :: iMlr = 1 - integer(I4B), parameter :: iMslr = 2 - integer(I4B), parameter :: iMrem = 3 - - associate(frag => self) - ! Get mass weighted mean of Ip and density - volume(1:2) = 4._DP / 3._DP * PI * colliders%radius(1:2)**3 - Ip_avg(:) = (colliders%mass(1) * colliders%Ip(:,1) + colliders%mass(2) * colliders%Ip(:,2)) / frag%mtot - if (colliders%mass(1) > colliders%mass(2)) then - jtarg = 1 - jproj = 2 - else - jtarg = 2 - jproj = 1 - end if - - select case(frag%regime) - case(COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC, COLLRESOLVE_REGIME_HIT_AND_RUN) - ! The first two bins of the mass_dist are the largest and second-largest fragments that came out of fraggle_regime. - ! The remainder from the third bin will be distributed among nfrag-2 bodies. The following code will determine nfrag based on - ! the limits bracketed above and the model size distribution of fragments. - ! Check to see if our size distribution would give us a smaller number of fragments than the maximum number - - select type(param) - class is (symba_parameters) - min_mfrag = (param%min_GMfrag / param%GU) - ! The number of fragments we generate is bracked by the minimum required by fraggle_generate (7) and the - ! maximum set by the NFRAG_SIZE_MULTIPLIER which limits the total number of fragments to prevent the nbody - ! code from getting an overwhelmingly large number of fragments - nfrag = ceiling(NFRAG_SIZE_MULTIPLIER * log(frag%mtot / min_mfrag)) - nfrag = max(min(nfrag, NFRAGMAX), NFRAGMIN) - class default - min_mfrag = 0.0_DP - nfrag = NFRAGMAX - end select - - i = iMrem - mremaining = frag%mass_dist(iMrem) - do while (i <= nfrag) - mfrag = (1 + i - iMslr)**(-3._DP / BETA) * frag%mass_dist(iMslr) - if (mremaining - mfrag < 0.0_DP) exit - mremaining = mremaining - mfrag - i = i + 1 - end do - if (i < nfrag) nfrag = max(i, NFRAGMIN) ! The sfd would actually give us fewer fragments than our maximum - - call frag%setup(nfrag, param) - case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - call frag%setup(1, param) - frag%mass(1) = frag%mass_dist(1) - frag%radius(1) = colliders%radius(jtarg) - frag%density(1) = frag%mass_dist(1) / volume(jtarg) - if (param%lrotation) frag%Ip(:, 1) = colliders%Ip(:,1) - return - case default - write(*,*) "fraggle_set_mass_dist_fragments error: Unrecognized regime code",frag%regime - end select - - ! Make the first two bins the same as the Mlr and Mslr values that came from fraggle_regime - frag%mass(1) = frag%mass_dist(iMlr) - frag%mass(2) = frag%mass_dist(iMslr) - - ! Distribute the remaining mass the 3:nfrag bodies following the model SFD given by slope BETA - mremaining = frag%mass_dist(iMrem) - do i = iMrem, nfrag - mfrag = (1 + i - iMslr)**(-3._DP / BETA) * frag%mass_dist(iMslr) - frag%mass(i) = mfrag - mremaining = mremaining - mfrag - end do - - ! If there is any residual mass (either positive or negative) we will distribute remaining mass proportionally among the the fragments - if (mremaining < 0.0_DP) then ! If the remainder is negative, this means that that the number of fragments required by the SFD is smaller than our lower limit set by fraggle_generate. - istart = iMrem ! We will reduce the mass of the 3:nfrag bodies to prevent the second-largest fragment from going smaller - else ! If the remainder is postiive, this means that the number of fragments required by the SFD is larger than our upper limit set by computational expediency. - istart = iMslr ! We will increase the mass of the 2:nfrag bodies to compensate, which ensures that the second largest fragment remains the second largest - end if - mfrag = 1._DP + mremaining / sum(frag%mass(istart:nfrag)) - frag%mass(istart:nfrag) = frag%mass(istart:nfrag) * mfrag - - ! There may still be some small residual due to round-off error. If so, simply add it to the last bin of the mass distribution. - mremaining = frag%mtot - sum(frag%mass(1:nfrag)) - frag%mass(nfrag) = frag%mass(nfrag) + mremaining - - ! Compute physical properties of the new fragments - select case(frag%regime) - case(COLLRESOLVE_REGIME_HIT_AND_RUN) ! The hit and run case always preserves the largest body intact, so there is no need to recompute the physical properties of the first fragment - frag%radius(1) = colliders%radius(jtarg) - frag%density(1) = frag%mass_dist(iMlr) / volume(jtarg) - frag%Ip(:, 1) = colliders%Ip(:,1) - istart = 2 - case default - istart = 1 - end select - frag%density(istart:nfrag) = frag%mtot / sum(volume(:)) - frag%radius(istart:nfrag) = (3 * frag%mass(istart:nfrag) / (4 * PI * frag%density(istart:nfrag)))**(1.0_DP / 3.0_DP) - do i = istart, nfrag - frag%Ip(:, i) = Ip_avg(:) - end do - - end associate - - return - end subroutine fraggle_set_mass_dist_fragments - - - module subroutine fraggle_set_coordinate_system(self, colliders) - !! author: David A. Minton - !! - !! Defines the collisional coordinate system, including the unit vectors of both the system and individual fragments. - implicit none - ! Arguments - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object - ! Internals - integer(I4B) :: i - real(DP), dimension(NDIM) :: delta_r, delta_v, Ltot - real(DP) :: r_col_norm, v_col_norm, L_mag - real(DP), dimension(NDIM, self%nbody) :: L_sigma - - associate(frag => self, nfrag => self%nbody) - delta_v(:) = colliders%vb(:, 2) - colliders%vb(:, 1) - v_col_norm = .mag. delta_v(:) - delta_r(:) = colliders%xb(:, 2) - colliders%xb(:, 1) - r_col_norm = .mag. delta_r(:) - - ! We will initialize fragments on a plane defined by the pre-impact system, with the z-axis aligned with the angular momentum vector - ! and the y-axis aligned with the pre-impact distance vector. - Ltot = colliders%L_orbit(:,1) + colliders%L_orbit(:,2) + colliders%L_spin(:,1) + colliders%L_spin(:,2) - frag%y_coll_unit(:) = delta_r(:) / r_col_norm - L_mag = .mag.Ltot(:) - if (L_mag > tiny(L_mag)) then - frag%z_coll_unit(:) = Ltot(:) / L_mag - else - frag%z_coll_unit(:) = 0.0_DP - end if - ! The cross product of the y- by z-axis will give us the x-axis - frag%x_coll_unit(:) = frag%y_coll_unit(:) .cross. frag%z_coll_unit(:) - - if (.not.any(frag%x_coll(:,:) > 0.0_DP)) return - frag%rmag(:) = .mag. frag%x_coll(:,:) - - call random_number(L_sigma(:,:)) ! Randomize the tangential velocity direction. This helps to ensure that the tangential velocity doesn't completely line up with the angular momentum vector, - ! otherwise we can get an ill-conditioned system - do concurrent(i = 1:nfrag, frag%rmag(i) > 0.0_DP) - frag%v_r_unit(:, i) = frag%x_coll(:, i) / frag%rmag(i) - frag%v_n_unit(:, i) = frag%z_coll_unit(:) + 2e-1_DP * (L_sigma(:,i) - 0.5_DP) - frag%v_n_unit(:, i) = frag%v_n_unit(:, i) / (.mag. frag%v_n_unit(:, i)) - frag%v_t_unit(:, i) = frag%v_n_unit(:, i) .cross. frag%v_r_unit(:, i) - frag%v_t_unit(:, i) = frag%v_t_unit(:, i) / (.mag. frag%v_t_unit(:, i)) - end do - end associate - - return - end subroutine fraggle_set_coordinate_system - - - module subroutine fraggle_set_natural_scale_factors(self, colliders) - !! author: David A. Minton - !! - !! Scales dimenional quantities to ~O(1) with respect to the collisional system. - !! This scaling makes it easier for the non-linear minimization to converge on a solution - implicit none - ! Arguments - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object - ! Internals - integer(I4B) :: i - - associate(frag => self) - ! Set scale factors - frag%Escale = 0.5_DP * (colliders%mass(1) * dot_product(colliders%vb(:,1), colliders%vb(:,1)) & - + colliders%mass(2) * dot_product(colliders%vb(:,2), colliders%vb(:,2))) - frag%dscale = sum(colliders%radius(:)) - frag%mscale = frag%mtot - frag%vscale = sqrt(frag%Escale / frag%mscale) - frag%tscale = frag%dscale / frag%vscale - frag%Lscale = frag%mscale * frag%dscale * frag%vscale - - ! Scale all dimensioned quantities of colliders and fragments - frag%xbcom(:) = frag%xbcom(:) / frag%dscale - frag%vbcom(:) = frag%vbcom(:) / frag%vscale - colliders%xb(:,:) = colliders%xb(:,:) / frag%dscale - colliders%vb(:,:) = colliders%vb(:,:) / frag%vscale - colliders%mass(:) = colliders%mass(:) / frag%mscale - colliders%radius(:) = colliders%radius(:) / frag%dscale - colliders%L_spin(:,:) = colliders%L_spin(:,:) / frag%Lscale - colliders%L_orbit(:,:) = colliders%L_orbit(:,:) / frag%Lscale - - do i = 1, 2 - colliders%rot(:,i) = colliders%L_spin(:,i) / (colliders%mass(i) * colliders%radius(i)**2 * colliders%Ip(3, i)) - end do - - frag%mtot = frag%mtot / frag%mscale - frag%mass = frag%mass / frag%mscale - frag%radius = frag%radius / frag%dscale - frag%Qloss = frag%Qloss / frag%Escale - end associate - - return - end subroutine fraggle_set_natural_scale_factors - - - module subroutine fraggle_set_original_scale_factors(self, colliders) - !! author: David A. Minton - !! - !! Restores dimenional quantities back to the system units - use, intrinsic :: ieee_exceptions - implicit none - ! Arguments - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object - ! Internals - integer(I4B) :: i - logical, dimension(size(IEEE_ALL)) :: fpe_halting_modes - - call ieee_get_halting_mode(IEEE_ALL,fpe_halting_modes) ! Save the current halting modes so we can turn them off temporarily - call ieee_set_halting_mode(IEEE_ALL,.false.) - - associate(frag => self) - - ! Restore scale factors - frag%xbcom(:) = frag%xbcom(:) * frag%dscale - frag%vbcom(:) = frag%vbcom(:) * frag%vscale - - colliders%mass = colliders%mass * frag%mscale - colliders%radius = colliders%radius * frag%dscale - colliders%xb = colliders%xb * frag%dscale - colliders%vb = colliders%vb * frag%vscale - colliders%L_spin = colliders%L_spin * frag%Lscale - do i = 1, 2 - colliders%rot(:,i) = colliders%L_spin(:,i) * (colliders%mass(i) * colliders%radius(i)**2 * colliders%Ip(3, i)) - end do - frag%Qloss = frag%Qloss * frag%Escale - - frag%mtot = frag%mtot * frag%mscale - frag%mass = frag%mass * frag%mscale - frag%radius = frag%radius * frag%dscale - frag%rot = frag%rot / frag%tscale - frag%x_coll = frag%x_coll * frag%dscale - frag%v_coll = frag%v_coll * frag%vscale - - do i = 1, frag%nbody - frag%xb(:, i) = frag%x_coll(:, i) + frag%xbcom(:) - frag%vb(:, i) = frag%v_coll(:, i) + frag%vbcom(:) - end do - - frag%mscale = 1.0_DP - frag%dscale = 1.0_DP - frag%vscale = 1.0_DP - frag%tscale = 1.0_DP - frag%Lscale = 1.0_DP - frag%Escale = 1.0_DP - end associate - call ieee_set_halting_mode(IEEE_ALL,fpe_halting_modes) - - return - end subroutine fraggle_set_original_scale_factors - - -end submodule s_fraggle_set \ No newline at end of file diff --git a/src/fraggle/fraggle_setup.f90 b/src/fraggle/fraggle_setup.f90 deleted file mode 100644 index 2eff96c29..000000000 --- a/src/fraggle/fraggle_setup.f90 +++ /dev/null @@ -1,87 +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. - -submodule (fraggle_classes) s_fraggle_setup - use swiftest -contains - - module subroutine fraggle_setup_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) - implicit none - ! Arguments - class(fraggle_fragments), intent(inout) :: self - - self%xb(:,:) = 0.0_DP - self%vb(:,:) = 0.0_DP - self%rot(:,:) = 0.0_DP - self%x_coll(:,:) = 0.0_DP - self%v_coll(:,:) = 0.0_DP - self%v_r_unit(:,:) = 0.0_DP - self%v_t_unit(:,:) = 0.0_DP - self%v_n_unit(:,:) = 0.0_DP - - self%rmag(:) = 0.0_DP - self%rotmag(:) = 0.0_DP - self%v_r_mag(:) = 0.0_DP - self%v_t_mag(:) = 0.0_DP - - self%ke_orbit = 0.0_DP - self%ke_spin = 0.0_DP - self%L_orbit(:) = 0.0_DP - self%L_spin(:) = 0.0_DP - - return - end subroutine fraggle_setup_reset_fragments - - - module subroutine fraggle_setup_fragments(self, n, param) - !! author: David A. Minton - !! - !! Allocates arrays for n fragments in a Fraggle system. Passing n = 0 deallocates all arrays. - implicit none - ! Arguments - class(fraggle_fragments), intent(inout) :: self - integer(I4B), intent(in) :: n - class(swiftest_parameters), intent(in) :: param - - call setup_pl(self, n, param) - if (n < 0) return - - if (allocated(self%x_coll)) deallocate(self%x_coll) - if (allocated(self%v_coll)) deallocate(self%v_coll) - if (allocated(self%v_r_unit)) deallocate(self%v_r_unit) - if (allocated(self%v_t_unit)) deallocate(self%v_t_unit) - if (allocated(self%v_n_unit)) deallocate(self%v_n_unit) - if (allocated(self%rmag)) deallocate(self%rmag) - if (allocated(self%rotmag)) deallocate(self%rotmag) - if (allocated(self%v_r_mag)) deallocate(self%v_r_mag) - if (allocated(self%v_t_mag)) deallocate(self%v_t_mag) - - if (n == 0) return - - allocate(self%x_coll(NDIM,n)) - allocate(self%v_coll(NDIM,n)) - allocate(self%v_r_unit(NDIM,n)) - allocate(self%v_t_unit(NDIM,n)) - allocate(self%v_n_unit(NDIM,n)) - allocate(self%rmag(n)) - allocate(self%rotmag(n)) - allocate(self%v_r_mag(n)) - allocate(self%v_t_mag(n)) - - call self%reset() - - return - end subroutine fraggle_setup_fragments - - - -end submodule s_fraggle_setup \ No newline at end of file diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 8d9594974..057dfe2b7 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -7,315 +7,366 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(fraggle_classes) s_fraggle_util +submodule(fraggle) s_fraggle_util use swiftest contains - module subroutine fraggle_util_add_fragments_to_system(frag, colliders, system, param) - !! Author: David A. Minton + module subroutine fraggle_util_reset_fragments(self) + !! author: David A. Minton !! - !! Adds fragments to the temporary system pl object + !! 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(fraggle_fragments), intent(in) :: frag !! Fraggle fragment system object - class(fraggle_colliders), intent(in) :: colliders !! Fraggle collider system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters - ! Internals - integer(I4B) :: i, npl_before, npl_after - logical, dimension(:), allocatable :: lexclude - - associate(nfrag => frag%nbody, pl => system%pl, cb => system%cb) - npl_after = pl%nbody - npl_before = npl_after - nfrag - allocate(lexclude(npl_after)) - - pl%status(npl_before+1:npl_after) = ACTIVE - pl%mass(npl_before+1:npl_after) = frag%mass(1:nfrag) - pl%Gmass(npl_before+1:npl_after) = frag%mass(1:nfrag) * param%GU - pl%radius(npl_before+1:npl_after) = frag%radius(1:nfrag) - do concurrent (i = 1:nfrag) - pl%xb(:,npl_before+i) = frag%xb(:,i) - pl%vb(:,npl_before+i) = frag%vb(:,i) - pl%xh(:,npl_before+i) = frag%xb(:,i) - cb%xb(:) - pl%vh(:,npl_before+i) = frag%vb(:,i) - cb%vb(:) - end do - if (param%lrotation) then - pl%Ip(:,npl_before+1:npl_after) = frag%Ip(:,1:nfrag) - pl%rot(:,npl_before+1:npl_after) = frag%rot(:,1:nfrag) - end if - ! This will remove the colliders from the system since we've replaced them with fragments - lexclude(1:npl_after) = .false. - lexclude(colliders%idx(1:colliders%ncoll)) = .true. - where(lexclude(1:npl_after)) - pl%status(1:npl_after) = INACTIVE - elsewhere - pl%status(1:npl_after) = ACTIVE - endwhere - - end associate - - return - end subroutine fraggle_util_add_fragments_to_system - - - module subroutine fraggle_util_ang_mtm(self) - !! Author: David A. Minton - !! - !! Calcualtes the current angular momentum of the fragments - implicit none - ! Arguments - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - ! Internals - integer(I4B) :: i - - associate(frag => self, nfrag => self%nbody) - frag%L_orbit(:) = 0.0_DP - frag%L_spin(:) = 0.0_DP - - do i = 1, nfrag - frag%L_orbit(:) = frag%L_orbit(:) + frag%mass(i) * (frag%x_coll(:, i) .cross. frag%v_coll(:, i)) - frag%L_spin(:) = frag%L_spin(:) + frag%mass(i) * frag%radius(i)**2 * frag%Ip(:, i) * frag%rot(:, i) - end do - end associate + class(fraggle_fragments(*)), intent(inout) :: self + + self%rc(:,:) = 0.0_DP + self%vc(:,:) = 0.0_DP + self%rh(:,:) = 0.0_DP + self%vh(:,:) = 0.0_DP + self%rb(:,:) = 0.0_DP + self%vb(:,:) = 0.0_DP + self%rot(:,:) = 0.0_DP + self%r_unit(:,:) = 0.0_DP + self%t_unit(:,:) = 0.0_DP + self%n_unit(:,:) = 0.0_DP + + self%rmag(:) = 0.0_DP + self%rotmag(:) = 0.0_DP return - end subroutine fraggle_util_ang_mtm + end subroutine fraggle_util_reset_fragments - module subroutine fraggle_util_construct_temporary_system(frag, system, param, tmpsys, tmpparam) - !! Author: David A. Minton + module subroutine fraggle_util_reset_system(self) + !! author: David A. Minton !! - !! Constructs a temporary internal system consisting of active bodies and additional fragments. This internal temporary system is used to calculate system energy with and without fragments - !! and optionally including fragments. + !! Resets the collider system and deallocates all allocatables implicit none ! Arguments - class(fraggle_fragments), intent(in) :: frag !! Fraggle fragment system object - class(swiftest_nbody_system), intent(in) :: system !! Original swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters - class(swiftest_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object - class(swiftest_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters - ! Internals - logical, dimension(:), allocatable :: linclude - integer(I4B) :: npl_tot - - associate(nfrag => frag%nbody, pl => system%pl, npl => system%pl%nbody, cb => system%cb) - ! Set up a new system based on the original - if (allocated(tmpparam)) deallocate(tmpparam) - if (allocated(tmpsys)) deallocate(tmpsys) - allocate(tmpparam, source=param) - call setup_construct_system(tmpsys, tmpparam) + class(collision_fraggle), intent(inout) :: self !! Collision system object - ! No test particles necessary for energy/momentum calcs - call tmpsys%tp%setup(0, param) + self%dscale = 1.0_DP + self%mscale = 1.0_DP + self%tscale = 1.0_DP + self%vscale = 1.0_DP + self%Escale = 1.0_DP + self%Lscale = 1.0_DP - ! Replace the empty central body object with a copy of the original - deallocate(tmpsys%cb) - allocate(tmpsys%cb, source=cb) - - ! Make space for the fragments - npl_tot = npl + nfrag - call tmpsys%pl%setup(npl_tot, tmpparam) - allocate(linclude(npl_tot)) - - ! Fill up the temporary system with all of the original bodies, leaving the spaces for fragments empty until we add them in later - linclude(1:npl) = .true. - linclude(npl+1:npl_tot) = .false. - call tmpsys%pl%fill(pl, linclude) - - ! Scale the temporary system to the natural units of the current Fraggle calculation - call tmpsys%rescale(tmpparam, frag%mscale, frag%dscale, frag%tscale) - - end associate + call collision_util_reset_system(self) return - end subroutine fraggle_util_construct_temporary_system + end subroutine fraggle_util_reset_system - module subroutine fraggle_util_get_energy_momentum(self, colliders, system, param, lbefore) - !! Author: David A. Minton + module subroutine fraggle_util_set_mass_dist(self, param) + !! author: David A. Minton + !! + !! Sets the mass of fragments based on the mass distribution returned by the regime calculation. + !! This subroutine must be run after the the setup routine has been run on the fragments !! - !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) - !! This subrourtine works by building a temporary internal massive body object out of the non-excluded bodies and optionally with fragments appended. - !! This will get passed to the energy calculation subroutine so that energy is computed exactly the same way is it is in the main program. - !! This will temporarily expand the massive body object in a temporary system object called tmpsys to feed it into symba_energy implicit none ! Arguments - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the system, with colliders included and fragments excluded or vice versa + class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object + class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters ! Internals - logical, dimension(:), allocatable :: lexclude - class(swiftest_nbody_system), allocatable, save :: tmpsys - class(swiftest_parameters), allocatable, save :: tmpparam - integer(I4B) :: npl_before, npl_after - - associate(frag => self, nfrag => self%nbody, pl => system%pl, cb => system%cb) - - ! Because we're making a copy of the massive body object with the excludes/fragments appended, we need to deallocate the - ! big k_plpl array and recreate it when we're done, otherwise we run the risk of blowing up the memory by - ! allocating two of these ginormous arrays simulteouously. This is not particularly efficient, but as this - ! subroutine should be called relatively infrequently, it shouldn't matter too much. - - npl_before = pl%nbody - npl_after = npl_before + nfrag - - ! Build the exluded body logical mask - allocate(lexclude(npl_after)) - if (lbefore) then - lexclude(1:npl_before) = .false. - lexclude(npl_before+1:npl_after) = .true. - call fraggle_util_construct_temporary_system(frag, system, param, tmpsys, tmpparam) + integer(I4B) :: i, j, jproj, jtarg, nfrag, istart + real(DP), dimension(2) :: volume + real(DP), dimension(NDIM) :: Ip_avg + real(DP) :: mfrag, mremaining, min_mfrag, mtot, mcumul, G + real(DP), parameter :: BETA = 2.85_DP + integer(I4B), parameter :: NFRAGMAX = 100 !! Maximum number of fragments that can be generated + integer(I4B), parameter :: NFRAGMIN = 7 !! Minimum number of fragments that can be generated (set by the fraggle_generate algorithm for constraining momentum and energy) + integer(I4B), parameter :: NFRAG_SIZE_MULTIPLIER = 3 !! Log-space scale factor that scales the number of fragments by the collisional system mass + integer(I4B), parameter :: iMlr = 1 + integer(I4B), parameter :: iMslr = 2 + integer(I4B), parameter :: iMrem = 3 + logical :: flipper + + associate(impactors => self%impactors) + ! Get mass weighted mean of Ip and density + volume(1:2) = 4._DP / 3._DP * PI * impactors%radius(1:2)**3 + mtot = sum(impactors%mass(:)) + G = impactors%Gmass(1) / impactors%mass(1) + Ip_avg(:) = (impactors%mass(1) * impactors%Ip(:,1) + impactors%mass(2) * impactors%Ip(:,2)) / mtot + + if (impactors%mass(1) > impactors%mass(2)) then + jtarg = 1 + jproj = 2 else - lexclude(1:npl_after) = .false. - lexclude(colliders%idx(1:colliders%ncoll)) = .true. - if (.not.allocated(tmpsys)) then - write(*,*) "Error in fraggle_util_get_energy_momentum. " // & - " This must be called with lbefore=.true. at least once before calling it with lbefore=.false." - call util_exit(FAILURE) + jtarg = 2 + jproj = 1 + end if + + select case(impactors%regime) + case(COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC, COLLRESOLVE_REGIME_HIT_AND_RUN) + ! The first two bins of the mass_dist are the largest and second-largest fragments that came out of collision_regime. + ! The remainder from the third bin will be distributed among nfrag-2 bodies. The following code will determine nfrag based on + ! the limits bracketed above and the model size distribution of fragments. + ! Check to see if our size distribution would give us a smaller number of fragments than the maximum number + + select type(param) + class is (swiftest_parameters) + min_mfrag = (param%min_GMfrag / param%GU) + ! The number of fragments we generate is bracked by the minimum required by fraggle_generate (7) and the + ! maximum set by the NFRAG_SIZE_MULTIPLIER which limits the total number of fragments to prevent the nbody + ! code from getting an overwhelmingly large number of fragments + nfrag = ceiling(NFRAG_SIZE_MULTIPLIER * log(mtot / min_mfrag)) + nfrag = max(min(nfrag, NFRAGMAX), NFRAGMIN) + class default + min_mfrag = 0.0_DP + nfrag = NFRAGMAX + end select + + i = iMrem + mremaining = impactors%mass_dist(iMrem) + do while (i <= nfrag) + mfrag = (1 + i - iMslr)**(-3._DP / BETA) * impactors%mass_dist(iMslr) + if (mremaining - mfrag < 0.0_DP) exit + mremaining = mremaining - mfrag + i = i + 1 + end do + if (i < nfrag) nfrag = max(i, NFRAGMIN) ! The sfd would actually give us fewer fragments than our maximum + call self%setup_fragments(nfrag) + + case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) + + call self%setup_fragments(1) + select type(fragments => self%fragments) + class is (collision_fragments(*)) + fragments%mass(1) = impactors%mass_dist(1) + fragments%Gmass(1) = G * impactors%mass_dist(1) + fragments%radius(1) = impactors%radius(jtarg) + fragments%density(1) = impactors%mass_dist(1) / volume(jtarg) + if (param%lrotation) fragments%Ip(:, 1) = impactors%Ip(:,1) + end select + return + case default + write(*,*) "collision_util_set_mass_dist_fragments error: Unrecognized regime code",impactors%regime + end select + + select type(fragments => self%fragments) + class is (collision_fragments(*)) + fragments%mtot = mtot + + ! Make the first two bins the same as the Mlr and Mslr values that came from collision_regime + fragments%mass(1) = impactors%mass_dist(iMlr) + fragments%mass(2) = impactors%mass_dist(iMslr) + + ! Distribute the remaining mass the 3:nfrag bodies following the model SFD given by slope BETA + mremaining = impactors%mass_dist(iMrem) + do i = iMrem, nfrag + mfrag = (1 + i - iMslr)**(-3._DP / BETA) * impactors%mass_dist(iMslr) + fragments%mass(i) = mfrag + mremaining = mremaining - mfrag + end do + + ! If there is any residual mass (either positive or negative) we will distribute remaining mass proportionally among the the fragments + if (mremaining < 0.0_DP) then ! If the remainder is negative, this means that that the number of fragments required by the SFD is smaller than our lower limit set by fraggle_generate. + istart = iMrem ! We will reduce the mass of the 3:nfrag bodies to prevent the second-largest fragment from going smaller + else ! If the remainder is postiive, this means that the number of fragments required by the SFD is larger than our upper limit set by computational expediency. + istart = iMslr ! We will increase the mass of the 2:nfrag bodies to compensate, which ensures that the second largest fragment remains the second largest + end if + mfrag = 1._DP + mremaining / sum(fragments%mass(istart:nfrag)) + fragments%mass(istart:nfrag) = fragments%mass(istart:nfrag) * mfrag + + ! There may still be some small residual due to round-off error. If so, simply add it to the last bin of the mass distribution. + mremaining = fragments%mtot - sum(fragments%mass(1:nfrag)) + fragments%mass(nfrag) = fragments%mass(nfrag) + mremaining + + fragments%Gmass(:) = G * fragments%mass(:) + + ! Compute physical properties of the new fragments + select case(impactors%regime) + case(COLLRESOLVE_REGIME_HIT_AND_RUN) ! The hit and run case always preserves the largest body intact, so there is no need to recompute the physical properties of the first fragment + fragments%radius(1) = impactors%radius(jtarg) + fragments%density(1) = impactors%mass_dist(iMlr) / volume(jtarg) + fragments%Ip(:, 1) = impactors%Ip(:,1) + istart = 2 + case default + istart = 1 + end select + + fragments%density(istart:nfrag) = fragments%mtot / sum(volume(:)) + fragments%radius(istart:nfrag) = (3 * fragments%mass(istart:nfrag) / (4 * PI * fragments%density(istart:nfrag)))**(1.0_DP / 3.0_DP) + do i = istart, nfrag + fragments%Ip(:, i) = Ip_avg(:) + end do + + ! For catastrophic impacts, we will assign each of the n>2 fragments to one of the two original bodies so that the fragment cloud occupies + ! roughly the same space as both original bodies. For all other disruption cases, we use body 2 as the center of the cloud. + fragments%origin_body(1) = 1 + fragments%origin_body(2) = 2 + if (impactors%regime == COLLRESOLVE_REGIME_SUPERCATASTROPHIC) then + mcumul = fragments%mass(1) + flipper = .true. + j = 2 + do i = 1, nfrag + if (flipper .and. (mcumul < impactors%mass(1))) then + flipper = .false. + j = 1 + else + j = 2 + flipper = .true. + end if + fragments%origin_body(i) = j + end do + else + fragments%origin_body(3:nfrag) = 2 end if - call fraggle_util_add_fragments_to_system(frag, colliders, tmpsys, tmpparam) - end if - - call tmpsys%pl%flatten(param) - call tmpsys%get_energy_and_momentum(param) + end select - ! Calculate the current fragment energy and momentum balances - if (lbefore) then - frag%Lorbit_before(:) = tmpsys%Lorbit(:) - frag%Lspin_before(:) = tmpsys%Lspin(:) - frag%Ltot_before(:) = tmpsys%Ltot(:) - frag%ke_orbit_before = tmpsys%ke_orbit - frag%ke_spin_before = tmpsys%ke_spin - frag%pe_before = tmpsys%pe - frag%Etot_before = tmpsys%te - else - frag%Lorbit_after(:) = tmpsys%Lorbit(:) - frag%Lspin_after(:) = tmpsys%Lspin(:) - frag%Ltot_after(:) = tmpsys%Ltot(:) - frag%ke_orbit_after = tmpsys%ke_orbit - frag%ke_spin_after = tmpsys%ke_spin - frag%pe_after = tmpsys%pe - frag%Etot_after = tmpsys%te - end if end associate return - end subroutine fraggle_util_get_energy_momentum + end subroutine fraggle_util_set_mass_dist - module subroutine fraggle_util_restructure(self, colliders, try, f_spin, r_max_start) - !! Author: David A. Minton + module subroutine fraggle_util_set_natural_scale_factors(self) + !! author: David A. Minton !! - !! Restructure the inputs after a failed attempt failed to find a set of positions and velocities that satisfy the energy and momentum constraints + !! Scales dimenional quantities to ~O(1) with respect to the collisional system. + !! This scaling makes it easier for the non-linear minimization to converge on a solution implicit none ! Arguments - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(in) :: colliders !! Fraggle collider system object - integer(I4B), intent(in) :: try !! The current number of times Fraggle has tried to find a solution - real(DP), intent(inout) :: f_spin !! Fraction of energy/momentum that goes into spin. This decreases ater a failed attempt - real(DP), intent(inout) :: r_max_start !! The maximum radial distance that the position calculation starts with. This increases after a failed attempt + class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object ! Internals - real(DP), save :: ke_tot_deficit, r_max_start_old, ke_avg_deficit_old - real(DP) :: delta_r, delta_r_max, ke_avg_deficit - real(DP), parameter :: ke_avg_deficit_target = 0.0_DP - - ! Introduce a bit of noise in the radius determination so we don't just flip flop between similar failed positions - associate(frag => self) - call random_number(delta_r_max) - delta_r_max = sum(colliders%radius(:)) * (1.0_DP + 2e-1_DP * (delta_r_max - 0.5_DP)) - if (try == 1) then - ke_tot_deficit = - (frag%ke_budget - frag%ke_orbit - frag%ke_spin) - ke_avg_deficit = ke_tot_deficit - delta_r = delta_r_max - else - ! Linearly interpolate the last two failed solution ke deficits to find a new distance value to try - ke_tot_deficit = ke_tot_deficit - (frag%ke_budget - frag%ke_orbit - frag%ke_spin) - ke_avg_deficit = ke_tot_deficit / try - delta_r = (r_max_start - r_max_start_old) * (ke_avg_deficit_target - ke_avg_deficit_old) & - / (ke_avg_deficit - ke_avg_deficit_old) - if (abs(delta_r) > delta_r_max) delta_r = sign(delta_r_max, delta_r) - end if - r_max_start_old = r_max_start - r_max_start = r_max_start + delta_r ! The larger lever arm can help if the problem is in the angular momentum step - ke_avg_deficit_old = ke_avg_deficit - - if (f_spin > epsilon(1.0_DP)) then ! Try reducing the fraction in spin - f_spin = f_spin / 2 - else - f_spin = 0.0_DP - end if - end associate + integer(I4B) :: i + real(DP) :: vesc + + associate(collider => self, fragments => self%fragments, impactors => self%impactors) + ! Set primary scale factors (mass, length, and time) based on the impactor properties at the time of collision + collider%mscale = minval(fragments%mass(:)) + collider%dscale = minval(fragments%radius(:)) + + vesc = sqrt(2 * sum(impactors%Gmass(:)) / sum(impactors%radius(:))) + collider%tscale = collider%dscale / vesc + + ! Set secondary scale factors for convenience + collider%vscale = collider%dscale / collider%tscale + collider%Escale = collider%mscale * collider%vscale**2 + collider%Lscale = collider%mscale * collider%dscale * collider%vscale + + ! Scale all dimensioned quantities of impactors and fragments + impactors%rbcom(:) = impactors%rbcom(:) / collider%dscale + impactors%vbcom(:) = impactors%vbcom(:) / collider%vscale + impactors%rbimp(:) = impactors%rbimp(:) / collider%dscale + impactors%rb(:,:) = impactors%rb(:,:) / collider%dscale + impactors%vb(:,:) = impactors%vb(:,:) / collider%vscale + impactors%rc(:,:) = impactors%rc(:,:) / collider%dscale + impactors%vc(:,:) = impactors%vc(:,:) / collider%vscale + impactors%mass(:) = impactors%mass(:) / collider%mscale + impactors%Gmass(:) = impactors%Gmass(:) / (collider%dscale**3/collider%tscale**2) + impactors%Mcb = impactors%Mcb / collider%mscale + impactors%radius(:) = impactors%radius(:) / collider%dscale + impactors%Lspin(:,:) = impactors%Lspin(:,:) / collider%Lscale + impactors%Lorbit(:,:) = impactors%Lorbit(:,:) / collider%Lscale + + do i = 1, 2 + impactors%rot(:,i) = impactors%Lspin(:,i) / (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3,i)) + end do + + fragments%mtot = fragments%mtot / collider%mscale + fragments%mass(:) = fragments%mass(:) / collider%mscale + fragments%Gmass(:) = fragments%Gmass(:) / (collider%dscale**3/collider%tscale**2) + fragments%radius(:) = fragments%radius(:) / collider%dscale + impactors%Qloss = impactors%Qloss / collider%Escale + end associate return - end subroutine fraggle_util_restructure + end subroutine fraggle_util_set_natural_scale_factors - module subroutine fraggle_util_shift_vector_to_origin(m_frag, vec_frag) - !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + module subroutine fraggle_util_set_original_scale_factors(self) + !! author: David A. Minton !! - !! Adjusts the position or velocity of the fragments as needed to align them with the origin + !! Restores dimenional quantities back to the system units + use, intrinsic :: ieee_exceptions implicit none ! Arguments - real(DP), dimension(:), intent(in) :: m_frag !! Fragment masses - real(DP), dimension(:,:), intent(inout) :: vec_frag !! Fragment positions or velocities in the center of mass frame - + class(collision_fraggle), intent(inout) :: self !! Fraggle fragment system object ! Internals - real(DP), dimension(NDIM) :: mvec_frag, COM_offset - integer(I4B) :: i, nfrag - real(DP) :: mtot - - mvec_frag(:) = 0.0_DP - mtot = sum(m_frag) - nfrag = size(m_frag) - - do i = 1, nfrag - mvec_frag = mvec_frag(:) + vec_frag(:,i) * m_frag(i) - end do - COM_offset(:) = -mvec_frag(:) / mtot - do i = 1, nfrag - vec_frag(:, i) = vec_frag(:, i) + COM_offset(:) - end do + integer(I4B) :: i + logical, dimension(size(IEEE_ALL)) :: fpe_halting_modes + + call ieee_get_halting_mode(IEEE_ALL,fpe_halting_modes) ! Save the current halting modes so we can turn them off temporarily + call ieee_set_halting_mode(IEEE_ALL,.false.) + + associate(collider => self, fragments => self%fragments, impactors => self%impactors) + + ! Restore scale factors + impactors%rbcom(:) = impactors%rbcom(:) * collider%dscale + impactors%vbcom(:) = impactors%vbcom(:) * collider%vscale + impactors%rbimp(:) = impactors%rbimp(:) * collider%dscale + + impactors%mass = impactors%mass * collider%mscale + impactors%Gmass(:) = impactors%Gmass(:) * (collider%dscale**3/collider%tscale**2) + impactors%Mcb = impactors%Mcb * collider%mscale + impactors%mass_dist = impactors%mass_dist * collider%mscale + impactors%radius = impactors%radius * collider%dscale + impactors%rb = impactors%rb * collider%dscale + impactors%vb = impactors%vb * collider%vscale + impactors%rc = impactors%rc * collider%dscale + impactors%vc = impactors%vc * collider%vscale + impactors%Lspin = impactors%Lspin * collider%Lscale + impactors%Lorbit = impactors%Lorbit * collider%Lscale + do i = 1, 2 + impactors%rot(:,i) = impactors%Lspin(:,i) * (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3,i)) + end do + + fragments%mtot = fragments%mtot * collider%mscale + fragments%mass(:) = fragments%mass(:) * collider%mscale + fragments%Gmass(:) = fragments%Gmass(:) * (collider%dscale**3/collider%tscale**2) + fragments%radius(:) = fragments%radius(:) * collider%dscale + fragments%rot(:,:) = fragments%rot(:,:) / collider%tscale + fragments%rc(:,:) = fragments%rc(:,:) * collider%dscale + fragments%vc(:,:) = fragments%vc(:,:) * collider%vscale + + do i = 1, fragments%nbody + fragments%rb(:, i) = fragments%rc(:, i) + impactors%rbcom(:) + fragments%vb(:, i) = fragments%vc(:, i) + impactors%vbcom(:) + end do + impactors%Qloss = impactors%Qloss * collider%Escale + + collider%Lorbit(:,:) = collider%Lorbit(:,:) * collider%Lscale + collider%Lspin(:,:) = collider%Lspin(:,:) * collider%Lscale + collider%Ltot(:,:) = collider%Ltot(:,:) * collider%Lscale + collider%ke_orbit(:) = collider%ke_orbit(:) * collider%Escale + collider%ke_spin(:) = collider%ke_spin(:) * collider%Escale + collider%pe(:) = collider%pe(:) * collider%Escale + collider%be(:) = collider%be(:) * collider%Escale + collider%Etot(:) = collider%Etot(:) * collider%Escale + + collider%mscale = 1.0_DP + collider%dscale = 1.0_DP + collider%vscale = 1.0_DP + collider%tscale = 1.0_DP + collider%Lscale = 1.0_DP + collider%Escale = 1.0_DP + end associate + call ieee_set_halting_mode(IEEE_ALL,fpe_halting_modes) + return - end subroutine fraggle_util_shift_vector_to_origin + end subroutine fraggle_util_set_original_scale_factors - module function fraggle_util_vmag_to_vb(v_r_mag, v_r_unit, v_t_mag, v_t_unit, m_frag, vcom) result(vb) - !! Author: David A. Minton + module subroutine fraggle_util_setup_fragments_system(self, nfrag) + !! author: David A. Minton !! - !! Converts radial and tangential velocity magnitudes into barycentric velocity + !! Initializer for the fragments of the collision system. implicit none ! Arguments - real(DP), dimension(:), intent(in) :: v_r_mag !! Unknown radial component of fragment velocity vector - real(DP), dimension(:), intent(in) :: v_t_mag !! Tangential component of velocity vector set previously by angular momentum constraint - real(DP), dimension(:,:), intent(in) :: v_r_unit, v_t_unit !! Radial and tangential unit vectors for each fragment - real(DP), dimension(:), intent(in) :: m_frag !! Fragment masses - real(DP), dimension(:), intent(in) :: vcom !! Barycentric velocity of collisional system center of mass - ! Result - real(DP), dimension(:,:), allocatable :: vb - ! Internals - integer(I4B) :: i, nfrag - - allocate(vb, mold=v_r_unit) - ! Make sure the velocity magnitude stays positive - nfrag = size(m_frag) - do i = 1, nfrag - vb(:,i) = abs(v_r_mag(i)) * v_r_unit(:, i) - end do - ! In order to keep satisfying the kinetic energy constraint, we must shift the origin of the radial component of the velocities to the center of mass - call fraggle_util_shift_vector_to_origin(m_frag, vb) - - do i = 1, nfrag - vb(:, i) = vb(:, i) + v_t_mag(i) * v_t_unit(:, i) + vcom(:) - end do + class(collision_fraggle), intent(inout) :: self !! Encounter collision system object + integer(I4B), intent(in) :: nfrag !! Number of fragments to create + + if (allocated(self%fragments)) deallocate(self%fragments) + allocate(fraggle_fragments(nbody=nfrag) :: self%fragments) + self%fragments%nbody = nfrag return - end function fraggle_util_vmag_to_vb + end subroutine fraggle_util_setup_fragments_system end submodule s_fraggle_util diff --git a/src/globals/globals_module.f90 b/src/globals/globals_module.f90 new file mode 100644 index 000000000..23162a872 --- /dev/null +++ b/src/globals/globals_module.f90 @@ -0,0 +1,127 @@ +!! 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. + +module globals + !! author: David A. Minton + !! graph: false + !! + !! Basic parameters, definitions, and global type definitions used throughout the Swiftest project + !! Adapted from David E. Kaufmann's Swifter routine: globals.f90 and module_swifter.f90 + use, intrinsic :: iso_fortran_env ! Use the intrinsic kind definitions + implicit none + public + + integer, parameter :: I8B = int64 !! Symbolic name for kind types of 8-byte integers + integer, parameter :: I4B = int32 !! Symbolic name for kind types of 4-byte integers + integer, parameter :: I2B = int16 !! Symbolic name for kind types of 2-byte integers + integer, parameter :: I1B = int8 !! Symbolic name for kind types of 1-byte integers + + integer, parameter :: SP = real32 !! Symbolic name for kind types of single-precision reals + integer, parameter :: DP = real64 !! Symbolic name for kind types of double-precision reals + integer, parameter :: QP = real128 !! Symbolic name for kind types of quad-precision reals + + real(DP), parameter :: PIBY2 = 1.570796326794896619231321691639751442099_DP !! Definition of /(\pi / 2\) + real(DP), parameter :: PI = 3.141592653589793238462643383279502884197_DP !! Definition of /(\pi\) + real(DP), parameter :: PI3BY2 = 4.712388980384689857693965074919254326296_DP !! Definition of /(3 \pi / 2\) + real(DP), parameter :: TWOPI = 6.283185307179586476925286766559005768394_DP !! Definition of 2 \pi + real(DP), parameter :: THIRD = 0.333333333333333333333333333333333333333_DP !! Definition of 1 / 3 + real(DP), parameter :: SIXTH = 0.166666666666666666666666666666666666667_DP !! Definition of 1 / 3 + real(DP), parameter :: DEG2RAD = PI / 180.0_DP !! Definition of conversion factor from degrees to radians + real(DP), parameter :: RAD2DEG = 180.0_DP / PI !! Definition of conversion factor from degrees to radians + real(DP), parameter :: GC = 6.6743E-11_DP !! Universal gravitational constant in SI units + real(DP), parameter :: einsteinC = 299792458.0_DP !! Speed of light in SI units + + integer(I4B), parameter :: LOWERCASE_BEGIN = iachar('a') !! ASCII character set parameter for lower to upper conversion - start of lowercase + integer(I4B), parameter :: LOWERCASE_END = iachar('z') !! ASCII character set parameter for lower to upper conversion - end of lowercase + integer(I4B), parameter :: UPPERCASE_OFFSET = iachar('A') - iachar('a') !! ASCII character set parameter for lower to upper conversion - offset between upper and lower + + real(SP), parameter :: VERSION_NUMBER = 1.0_SP !! swiftest version + + !> Symbolic name for integrator types + character(*), parameter :: UNKNOWN_INTEGRATOR = "UKNOWN INTEGRATOR" + character(*), parameter :: INT_BS = "Bulirsch-Stoer" + character(*), parameter :: INT_HELIO = "Democratic Heliocentric" + character(*), parameter :: INT_RA15 = "Radau 15th order" + character(*), parameter :: INT_TU4 = "T+U 4th order" + character(*), parameter :: INT_WHM = "Wisdom-Holman Method" + character(*), parameter :: INT_RMVS = "Regularized Mixed Variable Symplectic" + character(*), parameter :: INT_SYMBA = "SyMBA" + character(*), parameter :: INT_RINGMOONS = "SyMBA-RINGMOONS" + + integer(I4B), parameter :: STRMAX = 512 !! Maximum size of character strings + integer(I4B), parameter :: NAMELEN = 32 !! Maximum size of name strings + + character(*), parameter :: CB_TYPE_NAME = "Central Body" + character(*), parameter :: PL_TYPE_NAME = "Massive Body" + character(*), parameter :: TP_TYPE_NAME = "Test Particle" + character(*), parameter :: PL_TINY_TYPE_NAME = "Semi-Interacting Massive Body" + + ! OpenMP Parameters + integer(I4B) :: nthreads = 1 !! Number of OpenMP threads + integer(I4B), parameter :: NTHERSHOLD = 1000 !! Threshold value for OpenMP loop parallelization + + integer(I4B), parameter :: SUCCESS = 0 !! Symbolic name for function return/flag code for success + integer(I4B), parameter :: FAILURE = -1 !! Symbolic name for function return/flag code for failure + integer(I4B), parameter :: USAGE = -2 !! Symbolic name for function return/flag code for printing the usage message + integer(I4B), parameter :: HELP = -3 !! Symbolic name for function return/flag code for printing the usage message + + integer(I4B), parameter :: ELLIPSE = -1 !! Symbolic names for orbit types - ellipse + integer(I4B), parameter :: PARABOLA = 0 !! Symbolic names for orbit types - parabola + integer(I4B), parameter :: HYPERBOLA = 1 !! Symbolic names for orbit types - hyperbola + + !> Symbolic names for body/particle status codes: + integer(I4B), parameter :: ACTIVE = 0 + integer(I4B), parameter :: INACTIVE = 1 + integer(I4B), parameter :: DISCARDED_RMAX = -1 + integer(I4B), parameter :: DISCARDED_RMIN = -2 + integer(I4B), parameter :: DISCARDED_RMAXU = -3 + integer(I4B), parameter :: DISCARDED_PERI = -4 + integer(I4B), parameter :: DISCARDED_PLR = -5 + integer(I4B), parameter :: DISCARDED_PLQ = -6 + integer(I4B), parameter :: DISCARDED_DRIFTERR = -7 + integer(I4B), parameter :: MERGED = -8 + integer(I4B), parameter :: DISRUPTED = -9 + integer(I4B), parameter :: SUPERCATASTROPHIC = -10 + integer(I4B), parameter :: GRAZE_AND_MERGE = -11 + integer(I4B), parameter :: HIT_AND_RUN_DISRUPT = -12 + integer(I4B), parameter :: HIT_AND_RUN_PURE = -13 + integer(I4B), parameter :: COLLIDED = -14 + integer(I4B), parameter :: NEW_PARTICLE = -15 + integer(I4B), parameter :: OLD_PARTICLE = -16 + + !> String labels for body/particle addition/subtraction in discard file + character(*), parameter :: ADD = '+1' + character(*), parameter :: SUB = '-1' + + !> Standard file names + integer(I4B), parameter :: NDUMPFILES = 2 + character(*), dimension(2), parameter :: DUMP_CB_FILE = ['dump_cb1.bin', 'dump_cb2.bin' ] + character(*), dimension(2), parameter :: DUMP_PL_FILE = ['dump_pl1.bin', 'dump_pl2.bin' ] + character(*), dimension(2), parameter :: DUMP_TP_FILE = ['dump_tp1.bin', 'dump_tp2.bin' ] + character(*), dimension(2), parameter :: DUMP_NC_FILE = ['dump_bin1.nc', 'dump_bin2.nc' ] + character(*), dimension(2), parameter :: DUMP_PARAM_FILE = ['dump_param1.in', 'dump_param2.in'] + character(*), parameter :: SWIFTEST_LOG_FILE = "swiftest.log" !! Name of file to use to log output when using "COMPACT" display style + integer(I4B), parameter :: SWIFTEST_LOG_OUT = 33 !! File unit for log file when using "COMPACT" display style + + !> Default file names that can be changed by the user in the parameters file + character(*), parameter :: CB_INFILE = 'cb.in' + character(*), parameter :: PL_INFILE = 'pl.in' + character(*), parameter :: TP_INFILE = 'tp.in' + character(*), parameter :: NC_INFILE = 'in.nc' + character(*), parameter :: BIN_OUTFILE = 'data.nc' + integer(I4B), parameter :: BINUNIT = 20 !! File unit number for the binary output file + integer(I4B), parameter :: PARTICLEUNIT = 44 !! File unit number for the binary particle info output file + integer(I4B), parameter :: LUN = 42 !! File unit number for files that are opened and closed within a single subroutine call, and therefore should not collide + + !> Miscellaneous constants: + integer(I4B), parameter :: NDIM = 3 !! Number of dimensions in our reality + integer(I4B), parameter :: NDIM2 = 2 * NDIM !! 2x the number of dimensions + real(DP), parameter :: VSMALL = 2 * epsilon(1._DP) !! Very small number used to prevent floating underflow + +end module globals diff --git a/src/helio/helio_drift.f90 b/src/helio/helio_drift.f90 index 60c6d52a8..ad476a2b2 100644 --- a/src/helio/helio_drift.f90 +++ b/src/helio/helio_drift.f90 @@ -7,11 +7,11 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (helio_classes) s_helio_drift +submodule (helio) s_helio_drift use swiftest contains - module subroutine helio_drift_body(self, system, param, dt) + module subroutine helio_drift_body(self, nbody_system, param, dt) !! author: David A. Minton !! !! Loop through bodies and call Danby drift routine on democratic heliocentric coordinates @@ -21,7 +21,7 @@ module subroutine helio_drift_body(self, system, param, dt) implicit none ! Arguments class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + 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 ! Internals @@ -35,8 +35,8 @@ module subroutine helio_drift_body(self, system, param, dt) allocate(iflag(n)) iflag(:) = 0 allocate(mu(n)) - mu(:) = system%cb%Gmass - call drift_all(mu, self%xh, self%vb, self%nbody, param, dt, self%lmask, iflag) + mu(:) = nbody_system%cb%Gmass + call swiftest_drift_all(mu, self%rh, self%vb, self%nbody, param, dt, self%lmask, iflag) if (any(iflag(1:n) /= 0)) then where(iflag(1:n) /= 0) self%status(1:n) = DISCARDED_DRIFTERR do i = 1, n @@ -50,63 +50,63 @@ module subroutine helio_drift_body(self, system, param, dt) end subroutine helio_drift_body - module subroutine helio_drift_pl(self, system, param, dt) + module subroutine helio_drift_pl(self, nbody_system, param, dt) !! author: David A. Minton !! !! Wrapper function used to call the body drift routine from a helio_pl structure implicit none ! Arguments class(helio_pl), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + 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 - call helio_drift_body(self, system, param, dt) + call helio_drift_body(self, nbody_system, param, dt) return end subroutine helio_drift_pl - module subroutine helio_drift_tp(self, system, param, dt) + module subroutine helio_drift_tp(self, nbody_system, param, dt) !! author: David A. Minton !! !! Wrapper function used to call the body drift routine from a helio_pl structure implicit none ! Arguments class(helio_tp), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + 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 - call helio_drift_body(self, system, param, dt) + call helio_drift_body(self, nbody_system, param, dt) return end subroutine helio_drift_tp - pure elemental subroutine helio_drift_linear_one(xhx, xhy, xhz, ptx, pty, ptz, dt) + pure elemental subroutine helio_drift_linear_one(rhx, rhy, rhz, ptx, pty, ptz, dt) !! author: David A. Minton !! !! Calculate the linear drift for a single body implicit none - real(DP), intent(inout) :: xhx, xhy, xhz + real(DP), intent(inout) :: rhx, rhy, rhz real(DP), intent(in) :: ptx, pty, ptz, dt - xhx = xhx + ptx * dt - xhy = xhy + pty * dt - xhz = xhz + ptz * dt + rhx = rhx + ptx * dt + rhy = rhy + pty * dt + rhz = rhz + ptz * dt return end subroutine helio_drift_linear_one - subroutine helio_drift_linear_all(xh, pt, dt, n, lmask) + subroutine helio_drift_linear_all(rh, pt, dt, n, lmask) !! author: David A. Minton !! !! Loop through all the bodies and calculate the linear drift implicit none ! Arguments - real(DP), dimension(:,:), intent(inout) :: xh + real(DP), dimension(:,:), intent(inout) :: rh real(DP), dimension(:), intent(in) :: pt real(DP), intent(in) :: dt integer(I4B), intent(in) :: n @@ -114,11 +114,9 @@ subroutine helio_drift_linear_all(xh, pt, dt, n, lmask) ! Internals integer(I4B) :: i - !$omp parallel do simd default(shared) schedule(static) do i = 1, n - if (lmask(i)) call helio_drift_linear_one(xh(1,i), xh(2,i), xh(3,i), pt(1), pt(2), pt(3), dt) + if (lmask(i)) call helio_drift_linear_one(rh(1,i), rh(2,i), rh(3,i), pt(1), pt(2), pt(3), dt) end do - !$omp end parallel do simd return end subroutine helio_drift_linear_all @@ -148,7 +146,7 @@ module subroutine helio_drift_linear_pl(self, cb, dt, lbeg) pt(2) = sum(pl%Gmass(1:npl) * pl%vb(2,1:npl), self%lmask(1:npl)) pt(3) = sum(pl%Gmass(1:npl) * pl%vb(3,1:npl), self%lmask(1:npl)) pt(:) = pt(:) / cb%Gmass - call helio_drift_linear_all(pl%xh(:,:), pt(:), dt, npl, pl%lmask(:)) + call helio_drift_linear_all(pl%rh(:,:), pt(:), dt, npl, pl%lmask(:)) if (lbeg) then cb%ptbeg = pt(:) @@ -188,9 +186,9 @@ module subroutine helio_drift_linear_tp(self, cb, dt, lbeg) pt(:) = cb%ptend end if where (self%lmask(1:ntp)) - tp%xh(1, 1:ntp) = tp%xh(1, 1:ntp) + pt(1) * dt - tp%xh(2, 1:ntp) = tp%xh(2, 1:ntp) + pt(2) * dt - tp%xh(3, 1:ntp) = tp%xh(3, 1:ntp) + pt(3) * dt + tp%rh(1, 1:ntp) = tp%rh(1, 1:ntp) + pt(1) * dt + tp%rh(2, 1:ntp) = tp%rh(2, 1:ntp) + pt(2) * dt + tp%rh(3, 1:ntp) = tp%rh(3, 1:ntp) + pt(3) * dt end where end associate diff --git a/src/helio/helio_gr.f90 b/src/helio/helio_gr.f90 index 5ffbf60b2..2092fca6a 100644 --- a/src/helio/helio_gr.f90 +++ b/src/helio/helio_gr.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(helio_classes) s_helio_gr +submodule(helio) s_helio_gr use swiftest contains @@ -26,7 +26,7 @@ pure module subroutine helio_gr_kick_getacch_pl(self, param) if (self%nbody == 0) return associate(pl => self, npl => self%nbody) - call gr_kick_getacch(pl%mu, pl%xh, pl%lmask, npl, param%inv_c2, pl%agr) + call swiftest_gr_kick_getacch(pl%mu, pl%rh, pl%lmask, npl, param%inv_c2, pl%agr) pl%ah(:,1:npl) = pl%ah(:,1:npl) + pl%agr(:,1:npl) end associate @@ -49,7 +49,7 @@ pure module subroutine helio_gr_kick_getacch_tp(self, param) if (self%nbody == 0) return associate(tp => self, ntp => self%nbody) - call gr_kick_getacch(tp%mu, tp%xh, tp%lmask, ntp, param%inv_c2, tp%agr) + call swiftest_gr_kick_getacch(tp%mu, tp%rh, tp%lmask, ntp, param%inv_c2, tp%agr) tp%ah(:,1:ntp) = tp%ah(:,1:ntp) + tp%agr(:,1:ntp) end associate @@ -57,7 +57,7 @@ pure module subroutine helio_gr_kick_getacch_tp(self, param) end subroutine helio_gr_kick_getacch_tp - pure module subroutine helio_gr_p4_pl(self, system, param, dt) + pure module subroutine helio_gr_p4_pl(self, nbody_system, param, dt) !! author: David A. Minton !! !! Position kick to massive bodies due to p**4 term in the post-Newtonian correction @@ -67,7 +67,7 @@ pure module subroutine helio_gr_p4_pl(self, system, param, dt) implicit none ! Arguments class(helio_pl), intent(inout) :: self !! Swiftest particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + 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 !! Step size ! Internals @@ -77,7 +77,7 @@ pure module subroutine helio_gr_p4_pl(self, system, param, dt) associate(pl => self, npl => self%nbody) do concurrent(i = 1:npl, pl%lmask(i)) - call gr_p4_pos_kick(param, pl%xh(:, i), pl%vb(:, i), dt) + call swiftest_gr_p4_pos_kick(param, pl%rh(:, i), pl%vb(:, i), dt) end do end associate @@ -85,7 +85,7 @@ pure module subroutine helio_gr_p4_pl(self, system, param, dt) end subroutine helio_gr_p4_pl - pure module subroutine helio_gr_p4_tp(self, system, param, dt) + pure module subroutine helio_gr_p4_tp(self, nbody_system, param, dt) !! author: David A. Minton !! !! Position kick to test particles due to p**4 term in the post-Newtonian correction @@ -95,7 +95,7 @@ pure module subroutine helio_gr_p4_tp(self, system, param, dt) implicit none ! Arguments class(helio_tp), intent(inout) :: self !! Swiftest particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + 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 !! Step size ! Internals @@ -105,7 +105,7 @@ pure module subroutine helio_gr_p4_tp(self, system, param, dt) associate(tp => self, ntp => self%nbody) do concurrent(i = 1:ntp, tp%lmask(i)) - call gr_p4_pos_kick(param, tp%xh(:, i), tp%vb(:, i), dt) + call swiftest_gr_p4_pos_kick(param, tp%rh(:, i), tp%vb(:, i), dt) end do end associate diff --git a/src/helio/helio_kick.f90 b/src/helio/helio_kick.f90 index 067a6195c..6fb4fad43 100644 --- a/src/helio/helio_kick.f90 +++ b/src/helio/helio_kick.f90 @@ -7,11 +7,11 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(helio_classes) s_helio_kick +submodule(helio) s_helio_kick use swiftest contains - module subroutine helio_kick_getacch_pl(self, system, param, t, lbeg) + module subroutine helio_kick_getacch_pl(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Compute heliocentric accelerations of massive bodies @@ -21,17 +21,17 @@ module subroutine helio_kick_getacch_pl(self, system, param, t, lbeg) implicit none ! Arguments class(helio_pl), intent(inout) :: self !! Helio massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system 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 !! Current simulation time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step if (self%nbody == 0) return - associate(cb => system%cb, pl => self, npl => self%nbody) + associate(cb => nbody_system%cb, pl => self, npl => self%nbody) call pl%accel_int(param) if (param%loblatecb) then - call pl%accel_obl(system) + call pl%accel_obl(nbody_system) if (lbeg) then cb%aoblbeg = cb%aobl else @@ -39,7 +39,7 @@ module subroutine helio_kick_getacch_pl(self, system, param, t, lbeg) end if ! TODO: Implement tides ! if (param%ltides) then - ! call pl%accel_tides(system) + ! call pl%accel_tides(nbody_system) ! if (lbeg) then ! cb%atidebeg = cb%atide ! else @@ -47,7 +47,7 @@ module subroutine helio_kick_getacch_pl(self, system, param, t, lbeg) ! end if ! end if end if - if (param%lextra_force) call pl%accel_user(system, param, t, lbeg) + if (param%lextra_force) call pl%accel_user(nbody_system, param, t, lbeg) if (param%lgr) call pl%accel_gr(param) end associate @@ -55,7 +55,7 @@ module subroutine helio_kick_getacch_pl(self, system, param, t, lbeg) end subroutine helio_kick_getacch_pl - module subroutine helio_kick_getacch_tp(self, system, param, t, lbeg) + module subroutine helio_kick_getacch_tp(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Compute heliocentric accelerations of test particles @@ -65,22 +65,22 @@ module subroutine helio_kick_getacch_tp(self, system, param, t, lbeg) implicit none ! Arguments class(helio_tp), intent(inout) :: self !! Helio test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system 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 !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step if (self%nbody == 0) return - associate(tp => self, cb => system%cb, pl => system%pl, npl => system%pl%nbody) - system%lbeg = lbeg - if (system%lbeg) then - call tp%accel_int(param, pl%Gmass(1:npl), pl%xbeg(:,1:npl), npl) + 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%xend(:,1:npl), npl) + call tp%accel_int(param, pl%Gmass(1:npl), pl%rend(:,1:npl), npl) end if - if (param%loblatecb) call tp%accel_obl(system) - if (param%lextra_force) call tp%accel_user(system, param, t, lbeg) + if (param%loblatecb) call tp%accel_obl(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 @@ -88,7 +88,7 @@ module subroutine helio_kick_getacch_tp(self, system, param, t, lbeg) end subroutine helio_kick_getacch_tp - module subroutine helio_kick_vb_pl(self, system, param, t, dt, lbeg) + module subroutine helio_kick_vb_pl(self, nbody_system, param, t, dt, lbeg) !! author: David A. Minton !! !! Kick barycentric velocities of bodies @@ -98,7 +98,7 @@ module subroutine helio_kick_vb_pl(self, system, param, t, dt, lbeg) implicit none ! Arguments class(helio_pl), intent(inout) :: self !! Swiftest generic body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system 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 !! Current time real(DP), intent(in) :: dt !! Stepsize @@ -110,11 +110,11 @@ module subroutine helio_kick_vb_pl(self, system, param, t, dt, lbeg) associate(pl => self, npl => self%nbody) pl%ah(:, 1:npl) = 0.0_DP - call pl%accel(system, param, t, lbeg) + call pl%accel(nbody_system, param, t, lbeg) if (lbeg) then - call pl%set_beg_end(xbeg = pl%xh) + call pl%set_beg_end(rbeg = pl%rh) else - call pl%set_beg_end(xend = pl%xh) + call pl%set_beg_end(rend = pl%rh) end if do concurrent(i = 1:npl, pl%lmask(i)) pl%vb(1, i) = pl%vb(1, i) + pl%ah(1, i) * dt @@ -127,7 +127,7 @@ module subroutine helio_kick_vb_pl(self, system, param, t, dt, lbeg) end subroutine helio_kick_vb_pl - module subroutine helio_kick_vb_tp(self, system, param, t, dt, lbeg) + module subroutine helio_kick_vb_tp(self, nbody_system, param, t, dt, lbeg) !! author: David A. Minton !! !! Kick barycentric velocities of bodies @@ -137,7 +137,7 @@ module subroutine helio_kick_vb_tp(self, system, param, t, dt, lbeg) implicit none ! Arguments class(helio_tp), intent(inout) :: self !! Swiftest generic body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system 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 !! Current time real(DP), intent(in) :: dt !! Stepsize @@ -149,7 +149,7 @@ module subroutine helio_kick_vb_tp(self, system, param, t, dt, lbeg) associate(tp => self, ntp => self%nbody) tp%ah(:, 1:ntp) = 0.0_DP - call tp%accel(system, param, t, lbeg) + call tp%accel(nbody_system, param, t, lbeg) do concurrent(i = 1:ntp, tp%lmask(i)) tp%vb(:, i) = tp%vb(:, i) + tp%ah(:, i) * dt end do diff --git a/src/modules/helio_classes.f90 b/src/helio/helio_module.f90 similarity index 66% rename from src/modules/helio_classes.f90 rename to src/helio/helio_module.f90 index 3f12628b7..a9d41b1a9 100644 --- a/src/modules/helio_classes.f90 +++ b/src/helio/helio_module.f90 @@ -7,31 +7,25 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -module helio_classes +module helio !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! !! Definition of classes and methods specific to the Democratic Heliocentric Method !! Adapted from David E. Kaufmann's Swifter routine: module_helio.f90 - use swiftest_globals - use swiftest_classes, only : swiftest_cb, swiftest_pl, swiftest_tp, swiftest_nbody_system - use whm_classes, only : whm_nbody_system + use swiftest + use whm implicit none public - !******************************************************************************************************************************** - ! helio_nbody_system class definitions and method interfaces - !******************************************************************************************************************************** type, extends(whm_nbody_system) :: helio_nbody_system contains procedure :: step => helio_step_system !! Advance the Helio nbody system forward in time by one step - procedure :: initialize => helio_setup_initialize_system !! Performs Helio-specific initilization steps, including converting to DH coordinates - final :: helio_util_final_system !! Finalizes the Helio system object - deallocates all allocatables + procedure :: initialize => helio_util_setup_initialize_system !! Performs Helio-specific initilization steps, including converting to DH coordinates + final :: helio_final_system !! Finalizes the Helio nbody_system object - deallocates all allocatables end type helio_nbody_system - !******************************************************************************************************************************** - ! helio_cb class definitions and method interfaces - !******************************************************************************************************************************* + !> Helio central body particle class type, extends(swiftest_cb) :: helio_cb real(DP), dimension(NDIM) :: ptbeg !! negative barycentric velocity of the central body at the beginning of time step @@ -39,9 +33,6 @@ module helio_classes contains end type helio_cb - !******************************************************************************************************************************** - ! helio_pl class definitions and method interfaces - !******************************************************************************************************************************* !! Helio massive body particle class type, extends(swiftest_pl) :: helio_pl @@ -53,12 +44,9 @@ module helio_classes procedure :: accel => helio_kick_getacch_pl !! Compute heliocentric accelerations of massive bodies procedure :: kick => helio_kick_vb_pl !! Kicks the barycentric velocities procedure :: step => helio_step_pl !! Steps the body forward one stepsize - final :: helio_util_final_pl !! Finalizes the Helio massive body object - deallocates all allocatables + final :: helio_final_pl !! Finalizes the Helio massive body object - deallocates all allocatables end type helio_pl - !******************************************************************************************************************************** - ! helio_tp class definitions and method interfaces - !******************************************************************************************************************************* !! Helio test particle class type, extends(swiftest_tp) :: helio_tp @@ -70,33 +58,30 @@ module helio_classes procedure :: accel => helio_kick_getacch_tp !! Compute heliocentric accelerations of massive bodies procedure :: kick => helio_kick_vb_tp !! Kicks the barycentric velocities procedure :: step => helio_step_tp !! Steps the body forward one stepsize - final :: helio_util_final_tp !! Finalizes the Helio test particle object - deallocates all allocatables + final :: helio_final_tp !! Finalizes the Helio test particle object - deallocates all allocatables end type helio_tp interface - module subroutine helio_drift_body(self, system, param, dt) - use swiftest_classes, only : swiftest_body, swiftest_nbody_system, swiftest_parameters + module subroutine helio_drift_body(self, nbody_system, param, dt) implicit none class(swiftest_body), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + 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 helio_drift_body - module subroutine helio_drift_pl(self, system, param, dt) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters + module subroutine helio_drift_pl(self, nbody_system, param, dt) implicit none class(helio_pl), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + 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 helio_drift_pl - module subroutine helio_drift_tp(self, system, param, dt) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters + module subroutine helio_drift_tp(self, nbody_system, param, dt) implicit none class(helio_tp), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + 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 helio_drift_tp @@ -118,98 +103,87 @@ module subroutine helio_drift_linear_tp(self, cb, dt, lbeg) end subroutine helio_drift_linear_tp pure module subroutine helio_gr_kick_getacch_pl(self, param) - use swiftest_classes, only : swiftest_parameters implicit none class(helio_pl), intent(inout) :: self !! Helio massive body particle data structure class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine helio_gr_kick_getacch_pl pure module subroutine helio_gr_kick_getacch_tp(self, param) - use swiftest_classes, only : swiftest_parameters implicit none class(helio_tp), intent(inout) :: self !! Helio massive body particle data structure class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine helio_gr_kick_getacch_tp - pure module subroutine helio_gr_p4_pl(self, system, param, dt) - use swiftest_classes, only : swiftest_parameters, swiftest_nbody_system + pure module subroutine helio_gr_p4_pl(self, nbody_system, param, dt) implicit none class(helio_pl), intent(inout) :: self !! Swiftest particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + 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 !! Step size end subroutine helio_gr_p4_pl - pure module subroutine helio_gr_p4_tp(self, system, param, dt) - use swiftest_classes, only : swiftest_parameters, swiftest_nbody_system + pure module subroutine helio_gr_p4_tp(self, nbody_system, param, dt) implicit none class(helio_tp), intent(inout) :: self !! Swiftest particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + 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 !! Step size end subroutine helio_gr_p4_tp - module subroutine helio_kick_getacch_pl(self, system, param, t, lbeg) - use swiftest_classes, only : swiftest_parameters, swiftest_nbody_system + module subroutine helio_kick_getacch_pl(self, nbody_system, param, t, lbeg) implicit none class(helio_pl), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system 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 !! Current simulation time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine helio_kick_getacch_pl - module subroutine helio_kick_getacch_tp(self, system, param, t, lbeg) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters + module subroutine helio_kick_getacch_tp(self, nbody_system, param, t, lbeg) implicit none class(helio_tp), intent(inout) :: self !! Helio test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system 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 !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine helio_kick_getacch_tp - module subroutine helio_kick_vb_pl(self, system, param, t, dt, lbeg) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters + module subroutine helio_kick_vb_pl(self, nbody_system, param, t, dt, lbeg) implicit none class(helio_pl), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system 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 !! 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 helio_kick_vb_pl - module subroutine helio_kick_vb_tp(self, system, param, t, dt, lbeg) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters + module subroutine helio_kick_vb_tp(self, nbody_system, param, t, dt, lbeg) implicit none class(helio_tp), intent(inout) :: self !! Helio test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system 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 !! 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 helio_kick_vb_tp - module subroutine helio_setup_initialize_system(self, param) - use swiftest_classes, only : swiftest_parameters + module subroutine helio_util_setup_initialize_system(self, param) implicit none class(helio_nbody_system), intent(inout) :: self !! Helio nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine helio_setup_initialize_system + end subroutine helio_util_setup_initialize_system - module subroutine helio_step_pl(self, system, param, t, dt) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters + module subroutine helio_step_pl(self, nbody_system, param, t, dt) implicit none class(helio_pl), intent(inout) :: self !! Helio massive body particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Stepsize end subroutine helio_step_pl module subroutine helio_step_system(self, param, t, dt) - use swiftest_classes, only : swiftest_parameters implicit none class(helio_nbody_system), intent(inout) :: self !! Helio nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters @@ -217,31 +191,57 @@ module subroutine helio_step_system(self, param, t, dt) real(DP), intent(in) :: dt !! Current stepsize end subroutine helio_step_system - module subroutine helio_step_tp(self, system, param, t, dt) - use swiftest_classes, only : swiftest_cb, swiftest_parameters, swiftest_nbody_system + module subroutine helio_step_tp(self, nbody_system, param, t, dt) implicit none class(helio_tp), intent(inout) :: self !! Helio test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system 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 !! Current simulation time real(DP), intent(in) :: dt !! Stepsizee end subroutine helio_step_tp + end interface + + contains - module subroutine helio_util_final_pl(self) + subroutine helio_final_pl(self) + !! author: David A. Minton + !! + !! Finalize the Helio massive body object - deallocates all allocatables implicit none + ! Arguments type(helio_pl), intent(inout) :: self !! Helio massive body object - end subroutine helio_util_final_pl - module subroutine helio_util_final_system(self) + call self%dealloc() + + return + end subroutine helio_final_pl + + + subroutine helio_final_system(self) + !! author: David A. Minton + !! + !! Finalize the Helio nbody system object - deallocates all allocatables implicit none + ! Arguments type(helio_nbody_system), intent(inout) :: self !! Helio nbody system object - end subroutine helio_util_final_system - module subroutine helio_util_final_tp(self) + call whm_final_system(self%whm_nbody_system) + + return + end subroutine helio_final_system + + + subroutine helio_final_tp(self) + !! author: David A. Minton + !! + !! Finalize the Helio test particle object - deallocates all allocatables implicit none + ! Arguments type(helio_tp), intent(inout) :: self !! Helio test particle object - end subroutine helio_util_final_tp - end interface + call self%dealloc() + + return + end subroutine helio_final_tp -end module helio_classes +end module helio diff --git a/src/helio/helio_setup.f90 b/src/helio/helio_setup.f90 deleted file mode 100644 index 22187f526..000000000 --- a/src/helio/helio_setup.f90 +++ /dev/null @@ -1,33 +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. - -submodule(helio_classes) s_helio_setup - use swiftest -contains - - module subroutine helio_setup_initialize_system(self, param) - !! author: David A. Minton - !! - !! Initialize a Helio nbody system from files, converting all heliocentric quantities to barycentric. - !! - implicit none - ! Arguments - class(helio_nbody_system), intent(inout) :: self !! Helio nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - - call whm_setup_initialize_system(self, param) - call self%pl%h2b(self%cb) - call self%tp%h2b(self%cb) - call self%pl%sort("mass", ascending=.false.) - call self%pl%flatten(param) - - return - end subroutine helio_setup_initialize_system - -end submodule s_helio_setup \ No newline at end of file diff --git a/src/helio/helio_step.f90 b/src/helio/helio_step.f90 index 318a1bba2..dd2463246 100644 --- a/src/helio/helio_step.f90 +++ b/src/helio/helio_step.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(helio_classes) s_helio_step +submodule(helio) s_helio_step use swiftest contains @@ -16,7 +16,7 @@ module subroutine helio_step_system(self, param, t, dt) !! !! Step massive bodies and and active test particles ahead in heliocentric coordinates. !! - !! Currently there's no difference between this and the WHM system stepper, so this is just + !! Currently there's no difference between this and the WHM nbody_system stepper, so this is just !! a wrapper function to keep the method calls consistent for inherited types. !! !! Adapted from Hal Levison's Swift routine step_kdk.f @@ -34,7 +34,7 @@ module subroutine helio_step_system(self, param, t, dt) end subroutine helio_step_system - module subroutine helio_step_pl(self, system, param, t, dt) + module subroutine helio_step_pl(self, nbody_system, param, t, dt) !! author: David A. Minton !! !! Step massive bodies ahead Democratic Heliocentric method @@ -44,7 +44,7 @@ module subroutine helio_step_pl(self, system, param, t, dt) implicit none ! Arguments class(helio_pl), intent(inout) :: self !! Helio massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Stepsize @@ -54,7 +54,7 @@ module subroutine helio_step_pl(self, system, param, t, dt) if (self%nbody == 0) return associate(pl => self) - select type(cb => system%cb) + select type(cb => nbody_system%cb) class is (helio_cb) dth = 0.5_DP * dt if (pl%lfirst) then @@ -62,11 +62,11 @@ module subroutine helio_step_pl(self, system, param, t, dt) pl%lfirst = .false. end if call pl%lindrift(cb, dth, lbeg=.true.) - call pl%kick(system, param, t, dth, lbeg=.true.) - if (param%lgr) call pl%gr_pos_kick(system, param, dth) - call pl%drift(system, param, dt) - if (param%lgr) call pl%gr_pos_kick(system, param, dth) - call pl%kick(system, param, t + dt, dth, lbeg=.false.) + call pl%kick(nbody_system, param, t, dth, lbeg=.true.) + if (param%lgr) call pl%gr_pos_kick(nbody_system, param, dth) + call pl%drift(nbody_system, param, dt) + if (param%lgr) call pl%gr_pos_kick(nbody_system, param, dth) + call pl%kick(nbody_system, param, t + dt, dth, lbeg=.false.) call pl%lindrift(cb, dth, lbeg=.false.) call pl%vb2vh(cb) end select @@ -76,7 +76,7 @@ module subroutine helio_step_pl(self, system, param, t, dt) end subroutine helio_step_pl - module subroutine helio_step_tp(self, system, param, t, dt) + module subroutine helio_step_tp(self, nbody_system, param, t, dt) !! author: David A. Minton !! @@ -87,7 +87,7 @@ module subroutine helio_step_tp(self, system, param, t, dt) implicit none ! Arguments class(helio_tp), intent(inout) :: self !! Helio test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Stepsize @@ -97,7 +97,7 @@ module subroutine helio_step_tp(self, system, param, t, dt) if (self%nbody == 0) return associate(tp => self) - select type(cb => system%cb) + select type(cb => nbody_system%cb) class is (helio_cb) dth = 0.5_DP * dt if (tp%lfirst) then @@ -105,11 +105,11 @@ module subroutine helio_step_tp(self, system, param, t, dt) tp%lfirst = .false. end if call tp%lindrift(cb, dth, lbeg=.true.) - call tp%kick(system, param, t, dth, lbeg=.true.) - if (param%lgr) call tp%gr_pos_kick(system, param, dth) - call tp%drift(system, param, dt) - if (param%lgr) call tp%gr_pos_kick(system, param, dth) - call tp%kick(system, param, t + dt, dth, lbeg=.false.) + call tp%kick(nbody_system, param, t, dth, lbeg=.true.) + if (param%lgr) call tp%gr_pos_kick(nbody_system, param, dth) + call tp%drift(nbody_system, param, dt) + if (param%lgr) call tp%gr_pos_kick(nbody_system, param, dth) + call tp%kick(nbody_system, param, t + dt, dth, lbeg=.false.) call tp%lindrift(cb, dth, lbeg=.false.) call tp%vb2vh(vbcb = -cb%ptend) end select diff --git a/src/helio/helio_util.f90 b/src/helio/helio_util.f90 index 698bb4849..5de0564a0 100644 --- a/src/helio/helio_util.f90 +++ b/src/helio/helio_util.f90 @@ -1,55 +1,33 @@ !! 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 +!! 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 +!! 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. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. -submodule(helio_classes) s_helio_util +submodule(helio) s_helio_util use swiftest contains - module subroutine helio_util_final_pl(self) + module subroutine helio_util_setup_initialize_system(self, param) !! author: David A. Minton !! - !! Finalize the Helio massive body object - deallocates all allocatables - implicit none - ! Arguments - type(helio_pl), intent(inout) :: self !! Helio massive body object - - call self%dealloc() - - return - end subroutine helio_util_final_pl - - - module subroutine helio_util_final_system(self) - !! author: David A. Minton - !! - !! Finalize the Helio nbody system object - deallocates all allocatables - implicit none - ! Arguments - type(helio_nbody_system), intent(inout) :: self !! Helio nbody system object - - call self%dealloc() - - return - end subroutine helio_util_final_system - - - module subroutine helio_util_final_tp(self) - !! author: David A. Minton + !! Initialize a Helio nbody system from files, converting all heliocentric quantities to barycentric. !! - !! Finalize the Helio test particle object - deallocates all allocatables implicit none ! Arguments - type(helio_tp), intent(inout) :: self !! Helio test particle object + class(helio_nbody_system), intent(inout) :: self !! Helio nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - call self%dealloc() + call whm_util_setup_initialize_system(self, param) + call self%pl%h2b(self%cb) + call self%tp%h2b(self%cb) + call self%pl%sort("mass", ascending=.false.) + call self%pl%flatten(param) return - end subroutine helio_util_final_tp + end subroutine helio_util_setup_initialize_system -end submodule s_helio_util \ No newline at end of file +end submodule s_helio_util diff --git a/src/io/io.f90 b/src/io/io.f90 deleted file mode 100644 index aa797ddbe..000000000 --- a/src/io/io.f90 +++ /dev/null @@ -1,2256 +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. - -submodule (swiftest_classes) s_io - use swiftest -contains - - module subroutine io_conservation_report(self, param, lterminal) - !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Reports the current state of energy, mass, and angular momentum conservation in a run - implicit none - ! Arguments - 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 - ! Internals - real(DP), dimension(NDIM) :: Ltot_now, Lorbit_now, Lspin_now - real(DP) :: ke_orbit_now, ke_spin_now, pe_now, Eorbit_now - real(DP) :: Eorbit_error, Etotal_error, Ecoll_error - real(DP) :: GMtot_now - real(DP) :: Lerror, Merror - character(len=STRMAX) :: errmsg - character(len=*), parameter :: EGYFMT = '(ES23.16,10(",",ES23.16,:))' ! Format code for all simulation output - character(len=*), parameter :: EGYHEADER = '("t,Eorbit,Ecollisions,Lx,Ly,Lz,Mtot")' - integer(I4B), parameter :: EGYIU = 72 - character(len=*), parameter :: EGYTERMFMT = '(" DL/L0 = ", ES12.5 & - "; DEcollisions/|E0| = ", ES12.5, & - "; D(Eorbit+Ecollisions)/|E0| = ", ES12.5, & - "; DM/M0 = ", ES12.5)' - - associate(system => self, pl => self%pl, cb => self%cb, npl => self%pl%nbody) - if (((param%out_type == REAL4_TYPE) .or. (param%out_type == REAL8_TYPE)) .and. (param%energy_out /= "")) then - if (param%lfirstenergy .and. (param%out_stat /= "OLD")) then - open(unit=EGYIU, file=param%energy_out, form="formatted", status="replace", action="write", err=667, iomsg=errmsg) - write(EGYIU,EGYHEADER, err=667, iomsg=errmsg) - else - open(unit=EGYIU, file=param%energy_out, form="formatted", status="old", action="write", & - position="append", err=667, iomsg=errmsg) - end if - end if - - call pl%vb2vh(cb) - call pl%xh2xb(cb) - - call system%get_energy_and_momentum(param) - ke_orbit_now = system%ke_orbit - ke_spin_now = system%ke_spin - pe_now = system%pe - Lorbit_now(:) = system%Lorbit(:) - Lspin_now(:) = system%Lspin(:) - Eorbit_now = ke_orbit_now + ke_spin_now + pe_now - Ltot_now(:) = system%Ltot(:) + system%Lescape(:) - GMtot_now = system%GMtot + system%GMescape - - if (param%lfirstenergy) then - system%Eorbit_orig = Eorbit_now - system%GMtot_orig = GMtot_now - system%Lorbit_orig(:) = Lorbit_now(:) - system%Lspin_orig(:) = Lspin_now(:) - system%Ltot_orig(:) = Ltot_now(:) - param%lfirstenergy = .false. - end if - - if (((param%out_type == REAL4_TYPE) .or. (param%out_type == REAL8_TYPE)) .and. (param%energy_out /= "")) then - write(EGYIU,EGYFMT, err = 667, iomsg = errmsg) param%t, Eorbit_now, system%Ecollisions, Ltot_now, GMtot_now - close(EGYIU, err = 667, iomsg = errmsg) - end if - - if (.not.param%lfirstenergy) then - Lerror = norm2(Ltot_now(:) - system%Ltot_orig(:)) / norm2(system%Ltot_orig(:)) - Eorbit_error = (Eorbit_now - system%Eorbit_orig) / abs(system%Eorbit_orig) - Ecoll_error = system%Ecollisions / abs(system%Eorbit_orig) - Etotal_error = (Eorbit_now - system%Ecollisions - system%Eorbit_orig - system%Euntracked) / abs(system%Eorbit_orig) - Merror = (GMtot_now - system%GMtot_orig) / system%GMtot_orig - if (lterminal) write(*, EGYTERMFMT) Lerror, Ecoll_error, Etotal_error, Merror - if (abs(Merror) > 100 * epsilon(Merror)) then - write(*,*) "Severe error! Mass not conserved! Halting!" - if ((param%out_type == REAL4_TYPE) .or. (param%out_type == REAL8_TYPE)) then - write(*,*) "Merror = ", Merror - write(*,*) "GMtot_now : ",GMtot_now - write(*,*) "GMtot_orig: ",system%GMtot_orig - write(*,*) "Difference: ",GMtot_now - system%GMtot_orig - else if ((param%out_type == NETCDF_FLOAT_TYPE) .or. (param%out_type == NETCDF_DOUBLE_TYPE)) then - ! Save the frame of data to the bin file in the slot just after the present one for diagnostics - param%ioutput = param%ioutput + 1_I8B - call pl%xv2el(cb) - call self%write_hdr(param%nciu, param) - call cb%write_frame(param%nciu, param) - call pl%write_frame(param%nciu, param) - call param%nciu%close() - end if - call util_exit(FAILURE) - end if - end if - end associate - - return - - 667 continue - write(*,*) "Error writing energy and momentum tracking file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_conservation_report - - - module subroutine io_dump_param(self, param_file_name) - !! author: David A. Minton - !! - !! Dump integration parameters to file - !! - !! Adapted from David E. Kaufmann's Swifter routine io_dump_param.f90 - !! Adapted from Martin Duncan's Swift routine io_dump_param.f - implicit none - ! Arguments - 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) - ! Internals - character(STRMAX) :: errmsg !! Error message in UDIO procedure - integer(I4B) :: ierr - - open(unit = LUN, file = param_file_name, status='replace', form = 'FORMATTED', err = 667, iomsg = errmsg) - !! todo: Currently this procedure does not work in user-defined derived-type input mode - !! due to compiler incompatabilities - !write(LUN,'(DT)') param - call self%writer(LUN, iotype = "none", v_list = [0], iostat = ierr, iomsg = errmsg) - if (ierr == 0) then - close(LUN, err = 667, iomsg = errmsg) - return - end if - - 667 continue - write(*,*) "Error opening parameter dump file " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_dump_param - - - module subroutine io_dump_particle_info(self, iu) - !! author: David A. Minton - !! - !! Reads in particle information object information from an open file unformatted file - implicit none - ! Arguments - class(swiftest_particle_info), intent(in) :: self !! Particle metadata information object - integer(I4B), intent(in) :: iu !! Open file unit number - ! Internals - character(STRMAX) :: errmsg - - write(iu, err = 667, iomsg = errmsg) self%name - write(iu, err = 667, iomsg = errmsg) self%particle_type - write(iu, err = 667, iomsg = errmsg) self%origin_type - write(iu, err = 667, iomsg = errmsg) self%origin_time - write(iu, err = 667, iomsg = errmsg) self%collision_id - write(iu, err = 667, iomsg = errmsg) self%origin_xh(:) - write(iu, err = 667, iomsg = errmsg) self%origin_vh(:) - - return - - 667 continue - write(*,*) "Error writing particle metadata information from file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_dump_particle_info - - - module subroutine io_dump_particle_info_base(self, param, idx) - !! author: David A. Minton - !! - !! Dumps the particle information data to a file. - !! Pass a list of array indices for test particles (tpidx) and/or massive bodies (plidx) to append - implicit none - ! Arguments - class(swiftest_base), intent(inout) :: self !! Swiftest base object (can be cb, pl, or tp) - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I4B), dimension(:), optional, intent(in) :: idx !! Array of test particle indices to append to the particle file - - ! Internals - logical, save :: lfirst = .true. - integer(I4B) :: i - character(STRMAX) :: errmsg - - if ((param%out_type == REAL4_TYPE) .or. (param%out_type == REAL8_TYPE)) then - if (lfirst) then - select case(param%out_stat) - case('APPEND') - open(unit=LUN, file=param%particle_out, status='OLD', position='APPEND', form='UNFORMATTED', err=667, iomsg=errmsg) - case('NEW', 'UNKNOWN', 'REPLACE') - open(unit=LUN, file=param%particle_out, status=param%out_stat, form='UNFORMATTED', err=667, iomsg=errmsg) - case default - write(*,*) 'Invalid status code',trim(adjustl(param%out_stat)) - call util_exit(FAILURE) - end select - - lfirst = .false. - else - open(unit=LUN, file=param%particle_out, status='OLD', position= 'APPEND', form='UNFORMATTED', err=667, iomsg=errmsg) - end if - - select type(self) - class is (swiftest_cb) - write(LUN, err = 667, iomsg = errmsg) self%id - call self%info%dump(LUN) - class is (swiftest_body) - if (present(idx)) then - do i = 1, size(idx) - write(LUN, err = 667, iomsg = errmsg) self%id(idx(i)) - call self%info(idx(i))%dump(LUN) - end do - else - do i = 1, self%nbody - write(LUN, err = 667, iomsg = errmsg) self%id(i) - call self%info(i)%dump(LUN) - end do - end if - end select - - close(unit = LUN, err = 667, iomsg = errmsg) - else if ((param%out_type == NETCDF_FLOAT_TYPE) .or. (param%out_type == NETCDF_DOUBLE_TYPE)) then - call self%write_particle_info(param%nciu, param) - end if - - return - - 667 continue - write(*,*) "Error writing particle information file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_dump_particle_info_base - - - module subroutine io_dump_base(self, param) - !! author: David A. Minton - !! - !! Dump massive body data to files - !! - !! Adapted from David E. Kaufmann's Swifter routine: io_dump_pl.f90 and io_dump_tp.f90 - !! Adapted from Hal Levison's Swift routine io_dump_pl.f and io_dump_tp.f - implicit none - ! Arguments - class(swiftest_base), intent(inout) :: self !! Swiftest base object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: iu = LUN - character(len=:), allocatable :: dump_file_name - character(STRMAX) :: errmsg - - select type(self) - class is(swiftest_cb) - dump_file_name = trim(adjustl(param%incbfile)) - class is (swiftest_pl) - dump_file_name = trim(adjustl(param%inplfile)) - class is (swiftest_tp) - dump_file_name = trim(adjustl(param%intpfile)) - end select - open(unit = iu, file = dump_file_name, form = "UNFORMATTED", status = 'replace', err = 667, iomsg = errmsg) - select type(self) - class is (swiftest_body) - write(iu, err = 667, iomsg = errmsg) self%nbody - call io_write_frame_body(self,iu, param) - class is (swiftest_cb) - call io_write_frame_cb(self,iu, param) - end select - close(iu, err = 667, iomsg = errmsg) - - return - - 667 continue - write(*,*) "Error dumping body data to file " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_dump_base - - - module subroutine io_dump_system(self, param) - !! author: David A. Minton - !! - !! Dumps the state of the system to files in case the simulation is interrupted. - !! As a safety mechanism, there are two dump files that are written in alternating order - !! so that if a dump file gets corrupted during writing, the user can restart from the older one. - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - class(swiftest_parameters), allocatable :: dump_param !! Local parameters variable used to parameters change input file names - !! to dump file-specific values without changing the user-defined values - integer(I4B), save :: idx = 1 !! Index of current dump file. Output flips between 2 files for extra security - !! in case the program halts during writing - character(len=:), allocatable :: param_file_name - - allocate(dump_param, source=param) - param_file_name = trim(adjustl(DUMP_PARAM_FILE(idx))) - dump_param%in_form = XV - dump_param%out_stat = 'APPEND' - if ((param%out_type == REAL8_TYPE) .or. (param%out_type == REAL4_TYPE)) then - dump_param%in_type = REAL8_TYPE - dump_param%incbfile = trim(adjustl(DUMP_CB_FILE(idx))) - dump_param%inplfile = trim(adjustl(DUMP_PL_FILE(idx))) - dump_param%intpfile = trim(adjustl(DUMP_TP_FILE(idx))) - - dump_param%Eorbit_orig = self%Eorbit_orig - dump_param%GMtot_orig = self%GMtot_orig - dump_param%Ltot_orig(:) = self%Ltot_orig(:) - dump_param%Lorbit_orig(:) = self%Lorbit_orig(:) - dump_param%Lspin_orig(:) = self%Lspin_orig(:) - dump_param%GMescape = self%GMescape - dump_param%Ecollisions = self%Ecollisions - dump_param%Euntracked = self%Euntracked - dump_param%Lescape(:) = self%Lescape - - else if ((param%out_type == NETCDF_FLOAT_TYPE) .or. (param%out_type == NETCDF_DOUBLE_TYPE)) then - dump_param%in_type = NETCDF_DOUBLE_TYPE - dump_param%in_netcdf = trim(adjustl(DUMP_NC_FILE(idx))) - dump_param%nciu%id_chunk = self%pl%nbody + self%tp%nbody - dump_param%nciu%time_chunk = 1 - end if - dump_param%T0 = param%t - - call dump_param%dump(param_file_name) - - dump_param%out_form = XV - if ((param%out_type == REAL8_TYPE) .or. (param%out_type == REAL4_TYPE)) then - call self%cb%dump(dump_param) - call self%pl%dump(dump_param) - call self%tp%dump(dump_param) - else if ((param%out_type == NETCDF_FLOAT_TYPE) .or. (param%out_type == NETCDF_DOUBLE_TYPE)) then - dump_param%outfile = trim(adjustl(DUMP_NC_FILE(idx))) - dump_param%ioutput = 0 - call dump_param%nciu%initialize(dump_param) - call self%write_hdr(dump_param%nciu, dump_param) - call self%cb%write_frame(dump_param%nciu, dump_param) - call self%pl%write_frame(dump_param%nciu, dump_param) - call self%tp%write_frame(dump_param%nciu, dump_param) - call dump_param%nciu%close() - ! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) - call param%nciu%flush(param) - end if - - idx = idx + 1 - if (idx > NDUMPFILES) idx = 1 - - return - end subroutine io_dump_system - - - module function io_get_args(integrator, param_file_name) result(ierr) - !! author: David A. Minton - !! - !! Reads in the name of the parameter file from command line arguments. - implicit none - ! Arguments - integer(I4B) :: integrator !! Symbolic code of the requested integrator - character(len=:), allocatable :: param_file_name !! Name of the input parameters file - ! Result - integer(I4B) :: ierr !! I/O error code - ! Internals - character(len=STRMAX) :: arg1, arg2 - integer :: narg,ierr_arg1, ierr_arg2 - character(len=*),parameter :: linefmt = '(A)' - - ierr = -1 ! Default is to fail - narg = command_argument_count() ! - if (narg == 2) then - call get_command_argument(1, arg1, status = ierr_arg1) - call get_command_argument(2, arg2, status = ierr_arg2) - if ((ierr_arg1 == 0) .and. (ierr_arg2 == 0)) then - ierr = 0 - call io_toupper(arg1) - select case(arg1) - case('BS') - integrator = BS - case('HELIO') - integrator = HELIO - case('RA15') - integrator = RA15 - case('TU4') - integrator = TU4 - case('WHM') - integrator = WHM - case('RMVS') - integrator = RMVS - case('SYMBA') - integrator = SYMBA - case('RINGMOONS') - integrator = RINGMOONS - case default - integrator = UNKNOWN_INTEGRATOR - write(*,*) trim(adjustl(arg1)) // ' is not a valid integrator.' - ierr = -1 - end select - param_file_name = trim(adjustl(arg2)) - end if - else - call get_command_argument(1, arg1, status = ierr_arg1) - if (ierr_arg1 == 0) then - if (arg1 == '-v' .or. arg1 == '--version') then - call util_version() - else if (arg1 == '-h' .or. arg1 == '--help') then - call util_exit(HELP) - end if - end if - end if - if (ierr /= 0) call util_exit(USAGE) - - return - end function io_get_args - - - module function io_get_old_t_final_system(self, param) result(old_t_final) - !! author: David A. Minton - !! - !! Validates the dump file to check whether the dump file initial conditions duplicate the last frame of the binary output. - !! - implicit none - ! Arguments - class(swiftest_nbody_system), intent(in) :: self - class(swiftest_parameters), intent(in) :: param - ! Result - real(DP) :: old_t_final - ! Internals - class(swiftest_nbody_system), allocatable :: tmpsys - class(swiftest_parameters), allocatable :: tmpparam - integer(I4B) :: ierr, iu = LUN - character(len=STRMAX) :: errmsg - - old_t_final = 0.0_DP - allocate(tmpsys, source=self) - allocate(tmpparam, source=param) - - ierr = 0 - open(unit = iu, file = param%outfile, status = 'OLD', form = 'UNFORMATTED', err = 667, iomsg = errmsg) - do - ierr = tmpsys%read_frame(iu, tmpparam) - if (ierr /= 0) exit - end do - if (is_iostat_end(ierr)) then - old_t_final = tmpparam%t - close(iu) - return - end if - - 667 continue - write(*,*) "Error reading binary output file. " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end function io_get_old_t_final_system - - - module function io_get_token(buffer, ifirst, ilast, ierr) result(token) - !! author: David A. Minton - !! - !! Retrieves a character token from an input string. Here a token is defined as any set of contiguous non-blank characters not - !! beginning with or containing "!". If "!" is present, any remaining part of the buffer including the "!" is ignored - !! - !! Adapted from David E. Kaufmann's Swifter routine io_get_token.f90 - implicit none - ! Arguments - 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 - ! Result - character(len=:), allocatable :: token !! Returned token string - ! Internals - integer(I4B) :: i,ilength - - ilength = len(buffer) - - if (ifirst > ilength) then - ilast = ifirst - ierr = -1 !! Bad input - token = '' - return - end if - do i = ifirst, ilength - if (buffer(i:i) /= ' ') exit - end do - if ((i > ilength) .or. (buffer(i:i) == '!')) then - ifirst = i - ilast = i - ierr = -2 !! No valid token - token = '' - return - end if - ifirst = i - do i = ifirst, ilength - if ((buffer(i:i) == ' ') .or. (buffer(i:i) == '!')) exit - end do - ilast = i - 1 - ierr = 0 - - token = buffer(ifirst:ilast) - - return - end function io_get_token - - - module subroutine io_log_one_message(file, message) - !! author: David A. Minton - !! - !! Writes a single message to a log file - implicit none - ! Arguments - character(len=*), intent(in) :: file !! Name of file to log - character(len=*), intent(in) :: message - ! Internals - character(STRMAX) :: errmsg - - open(unit=LUN, file=trim(adjustl(file)), status = 'OLD', position = 'APPEND', form = 'FORMATTED', err = 667, iomsg = errmsg) - write(LUN, *) trim(adjustl(message)) - close(LUN) - - return - 667 continue - write(*,*) "Error writing message to log file: " // trim(adjustl(errmsg)) - end subroutine io_log_one_message - - - module subroutine io_log_start(param, file, header) - !! author: David A. Minton - !! - !! Checks to see if a log file needs to be created if this is a new run, or appended if this is a restarted run - implicit none - ! Arguments - 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 - ! Internals - character(STRMAX) :: errmsg - logical :: fileExists - - inquire(file=trim(adjustl(file)), exist=fileExists) - if (.not.param%lrestart .or. .not.fileExists) then - open(unit=LUN, file=file, status="REPLACE", err = 667, iomsg = errmsg) - write(LUN, *, err = 667, iomsg = errmsg) trim(adjustl(header)) - end if - close(LUN) - - return - - 667 continue - write(*,*) "Error writing log file: " // trim(adjustl(errmsg)) - end subroutine io_log_start - - - module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) - !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Read in parameters for the integration - !! Currently this procedure does not work in user-defined derived-type input mode - !! e.g. read(unit,'(DT)') param - !! as the newline characters are ignored in the input file when compiled in ifort. - !! - !! Adapted from David E. Kaufmann's Swifter routine io_init_param.f90 - !! Adapted from Martin Duncan's Swift routine io_init_param.f - use, intrinsic :: iso_fortran_env - implicit none - ! Arguments - class(swiftest_parameters), intent(inout) :: self !! Collection of parameters - integer, 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, intent(in) :: v_list(:) !! The first element passes the integrator code to the reader - integer, intent(out) :: iostat !! IO status code - character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 - ! Internals - logical :: t0_set = .false. !! Is the initial time set in the input file? - logical :: tstop_set = .false. !! Is the final time set in the input file? - logical :: dt_set = .false. !! Is the step size set in the input file? - integer(I4B) :: ilength, ifirst, ilast, i !! Variables used to parse input file - character(STRMAX) :: line !! Line of the input file - character (len=:), allocatable :: line_trim,param_name, param_value !! Strings used to parse the param file - character(*),parameter :: linefmt = '(A)' !! Format code for simple text string - - - ! Parse the file line by line, extracting tokens then matching them up with known parameters if possible - associate(param => self) - open(unit = unit, file = param%param_file_name, status = 'old', err = 667, iomsg = iomsg) - do - read(unit = unit, fmt = linefmt, end = 1, err = 667, iomsg = iomsg) line - line_trim = trim(adjustl(line)) - ilength = len(line_trim) - if ((ilength /= 0)) then - ifirst = 1 - ! Read the pair of tokens. The first one is the parameter name, the second is the value. - param_name = io_get_token(line_trim, ifirst, ilast, iostat) - if (param_name == '') cycle ! No parameter name (usually because this line is commented out) - call io_toupper(param_name) - ifirst = ilast + 1 - param_value = io_get_token(line_trim, ifirst, ilast, iostat) - select case (param_name) - case ("T0") - read(param_value, *, err = 667, iomsg = iomsg) param%t0 - t0_set = .true. - case ("TSTOP") - read(param_value, *, err = 667, iomsg = iomsg) param%tstop - tstop_set = .true. - case ("DT") - read(param_value, *, err = 667, iomsg = iomsg) param%dt - dt_set = .true. - case ("CB_IN") - param%incbfile = param_value - case ("PL_IN") - param%inplfile = param_value - case ("TP_IN") - param%intpfile = param_value - case ("NC_IN") - param%in_netcdf = param_value - case ("IN_TYPE") - call io_toupper(param_value) - param%in_type = param_value - case ("IN_FORM") - call io_toupper(param_value) - param%in_form = param_value - case ("ISTEP_OUT") - read(param_value, *) param%istep_out - case ("BIN_OUT") - param%outfile = param_value - case ("OUT_TYPE") - call io_toupper(param_value) - param%out_type = param_value - case ("OUT_FORM") - call io_toupper(param_value) - param%out_form = param_value - case ("OUT_STAT") - call io_toupper(param_value) - param%out_stat = param_value - case ("ISTEP_DUMP") - read(param_value, *, err = 667, iomsg = iomsg) param%istep_dump - case ("CHK_CLOSE") - call io_toupper(param_value) - if (param_value == "YES" .or. param_value == 'T') param%lclose = .true. - case ("CHK_RMIN") - read(param_value, *, err = 667, iomsg = iomsg) param%rmin - case ("CHK_RMAX") - read(param_value, *, err = 667, iomsg = iomsg) param%rmax - case ("CHK_EJECT") - read(param_value, *, err = 667, iomsg = iomsg) param%rmaxu - case ("CHK_QMIN") - read(param_value, *, err = 667, iomsg = iomsg) param%qmin - case ("CHK_QMIN_COORD") - call io_toupper(param_value) - param%qmin_coord = param_value - case ("CHK_QMIN_RANGE") - read(param_value, *, err = 667, iomsg = iomsg) param%qmin_alo - ifirst = ilast + 1 - param_value = io_get_token(line, ifirst, ilast, iostat) - read(param_value, *, err = 667, iomsg = iomsg) param%qmin_ahi - case ("ENC_OUT") - param%enc_out = param_value - case ("DISCARD_OUT") - param%discard_out = param_value - case ("ENERGY_OUT") - param%energy_out = param_value - case ("EXTRA_FORCE") - call io_toupper(param_value) - if (param_value == "YES" .or. param_value == 'T') param%lextra_force = .true. - case ("BIG_DISCARD") - call io_toupper(param_value) - if (param_value == "YES" .or. param_value == 'T' ) param%lbig_discard = .true. - case ("RHILL_PRESENT") - call io_toupper(param_value) - if (param_value == "YES" .or. param_value == 'T' ) param%lrhill_present = .true. - case ("MU2KG") - read(param_value, *, err = 667, iomsg = iomsg) param%MU2KG - case ("TU2S") - read(param_value, *, err = 667, iomsg = iomsg) param%TU2S - case ("DU2M") - read(param_value, *, err = 667, iomsg = iomsg) param%DU2M - case ("ENERGY") - call io_toupper(param_value) - if (param_value == "YES" .or. param_value == 'T') param%lenergy = .true. - case ("GR") - call io_toupper(param_value) - if (param_value == "YES" .or. param_value == 'T') param%lgr = .true. - case ("ROTATION") - call io_toupper(param_value) - if (param_value == "YES" .or. param_value == 'T') param%lrotation = .true. - case ("TIDES") - call io_toupper(param_value) - if (param_value == "YES" .or. param_value == 'T') param%ltides = .true. - case ("INTERACTION_LOOPS") - call io_toupper(param_value) - param%interaction_loops = param_value - case ("ENCOUNTER_CHECK_PLPL") - call io_toupper(param_value) - param%encounter_check_plpl = param_value - case ("ENCOUNTER_CHECK_PLTP") - call io_toupper(param_value) - param%encounter_check_pltp = param_value - case ("ENCOUNTER_CHECK") - call io_toupper(param_value) - param%encounter_check_plpl = param_value - param%encounter_check_pltp = param_value - case ("FIRSTKICK") - call io_toupper(param_value) - if (param_value == "NO" .or. param_value == 'F') param%lfirstkick = .false. - case ("FIRSTENERGY") - call io_toupper(param_value) - if (param_value == "NO" .or. param_value == 'F') param%lfirstenergy = .false. - case("EORBIT_ORIG") - read(param_value, *, err = 667, iomsg = iomsg) param%Eorbit_orig - case("GMTOT_ORIG") - read(param_value, *, err = 667, iomsg = iomsg) param%GMtot_orig - case("LTOT_ORIG") - read(param_value, *, err = 667, iomsg = iomsg) param%Ltot_orig(1) - do i = 2, NDIM - ifirst = ilast + 2 - param_value = io_get_token(line, ifirst, ilast, iostat) - read(param_value, *, err = 667, iomsg = iomsg) param%Ltot_orig(i) - end do - case("LORBIT_ORIG") - read(param_value, *, err = 667, iomsg = iomsg) param%Lorbit_orig(1) - do i = 2, NDIM - ifirst = ilast + 2 - param_value = io_get_token(line, ifirst, ilast, iostat) - read(param_value, *, err = 667, iomsg = iomsg) param%Lorbit_orig(i) - end do - case("LSPIN_ORIG") - read(param_value, *, err = 667, iomsg = iomsg) param%Lspin_orig(1) - do i = 2, NDIM - ifirst = ilast + 2 - param_value = io_get_token(line, ifirst, ilast, iostat) - read(param_value, *, err = 667, iomsg = iomsg) param%Lspin_orig(i) - end do - case("LESCAPE") - read(param_value, *, err = 667, iomsg = iomsg) param%Lescape(1) - do i = 2, NDIM - ifirst = ilast + 2 - param_value = io_get_token(line, ifirst, ilast, iostat) - read(param_value, *, err = 667, iomsg = iomsg) param%Lescape(i) - end do - case("GMESCAPE") - read(param_value, *, err = 667, iomsg = iomsg) param%GMescape - case("ECOLLISIONS") - read(param_value, *, err = 667, iomsg = iomsg) param%Ecollisions - case("EUNTRACKED") - read(param_value, *, err = 667, iomsg = iomsg) param%Euntracked - case ("MAXID") - read(param_value, *, err = 667, iomsg = iomsg) param%maxid - case ("MAXID_COLLISION") - read(param_value, *, err = 667, iomsg = iomsg) param%maxid_collision - case ("PARTICLE_OUT") - param%particle_out = param_value - case ("NPLMAX", "NTPMAX", "GMTINY", "MIN_GMFRAG", "FRAGMENTATION", "SEED", "YARKOVSKY", "YORP") ! Ignore SyMBA-specific, not-yet-implemented, or obsolete input parameters - case default - write(*,*) "Ignoring unknown parameter -> ",param_name - end select - end if - end do - 1 continue - close(unit) - iostat = 0 - - ! Do basic sanity checks on the input values - if ((.not. t0_set) .or. (.not. tstop_set) .or. (.not. dt_set)) then - write(iomsg,*) 'Valid simulation time not set' - iostat = -1 - return - end if - if (param%dt <= 0.0_DP) then - write(iomsg,*) 'Invalid timestep: ' - iostat = -1 - return - end if - if (param%inplfile == "") then - write(iomsg,*) 'No valid massive body file in input file' - iostat = -1 - return - end if - if ((param%in_type /= REAL8_TYPE) .and. (param%in_type /= "ASCII") & - .and. (param%in_type /= NETCDF_FLOAT_TYPE) .and. (param%in_type /= NETCDF_DOUBLE_TYPE)) then - write(iomsg,*) 'Invalid input file type:',trim(adjustl(param%in_type)) - iostat = -1 - return - end if - if ((param%istep_out <= 0) .and. (param%istep_dump <= 0)) then - write(iomsg,*) 'Invalid istep' - iostat = -1 - return - end if - if ((param%istep_out > 0) .and. (param%outfile == "")) then - write(iomsg,*) 'Invalid outfile' - iostat = -1 - return - end if - param%lrestart = (param%out_stat == "APPEND") - if (param%outfile /= "") then - if ((param%out_type /= REAL4_TYPE) .and. (param%out_type /= REAL8_TYPE) .and. & - (param%out_type /= NETCDF_FLOAT_TYPE) .and. (param%out_type /= NETCDF_DOUBLE_TYPE)) then - write(iomsg,*) 'Invalid out_type: ',trim(adjustl(param%out_type)) - iostat = -1 - return - end if - if ((param%out_form /= "EL") .and. (param%out_form /= "XV") .and. (param%out_form /= "XVEL")) then - write(iomsg,*) 'Invalid out_form: ',trim(adjustl(param%out_form)) - iostat = -1 - return - end if - if ((param%out_stat /= "NEW") .and. (param%out_stat /= "REPLACE") .and. (param%out_stat /= "APPEND") & - .and. (param%out_stat /= "UNKNOWN")) then - write(iomsg,*) 'Invalid out_stat: ',trim(adjustl(param%out_stat)) - iostat = -1 - return - end if - end if - if (param%qmin > 0.0_DP) then - if ((param%qmin_coord /= "HELIO") .and. (param%qmin_coord /= "BARY")) then - write(iomsg,*) 'Invalid qmin_coord: ',trim(adjustl(param%qmin_coord)) - iostat = -1 - return - end if - if ((param%qmin_alo <= 0.0_DP) .or. (param%qmin_ahi <= 0.0_DP)) then - write(iomsg,*) 'Invalid qmin vals' - iostat = -1 - return - end if - end if - if (param%ltides .and. .not. param%lrotation) then - write(iomsg,*) 'Tides require rotation to be turned on' - iostat = -1 - return - end if - - if ((param%MU2KG < 0.0_DP) .or. (param%TU2S < 0.0_DP) .or. (param%DU2M < 0.0_DP)) then - write(iomsg,*) 'Invalid unit conversion factor' - iostat = -1 - return - end if - - ! Calculate the G for the system units - param%GU = GC / (param%DU2M**3 / (param%MU2KG * param%TU2S**2)) - - associate(integrator => v_list(1)) - if ((integrator == RMVS) .or. (integrator == SYMBA)) then - if (.not.param%lclose) then - write(iomsg,*) 'This integrator requires CHK_CLOSE to be enabled.' - iostat = -1 - return - end if - end if - - ! Determine if the GR flag is set correctly for this integrator - select case(integrator) - case(WHM, RMVS, HELIO, SYMBA) - case default - if (param%lgr) write(iomsg, *) 'GR is not yet implemented for this integrator. This parameter will be ignored.' - param%lgr = .false. - end select - - if (param%lgr) then - ! Calculate the inverse speed of light in the system units - param%inv_c2 = einsteinC * param%TU2S / param%DU2M - param%inv_c2 = (param%inv_c2)**(-2) - end if - - end associate - - select case(trim(adjustl(param%interaction_loops))) - case("ADAPTIVE") - param%ladaptive_interactions = .true. - param%lflatten_interactions = .true. - call io_log_start(param, INTERACTION_TIMER_LOG_OUT, "Interaction loop timer logfile") - call io_log_one_message(INTERACTION_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, nplpl, metric") - case("TRIANGULAR") - param%ladaptive_interactions = .false. - param%lflatten_interactions = .false. - case("FLAT") - param%ladaptive_interactions = .false. - param%lflatten_interactions = .true. - case default - write(*,*) "Unknown value for parameter INTERACTION_LOOPS: -> ",trim(adjustl(param%interaction_loops)) - write(*,*) "Must be one of the following: TRIANGULAR, FLAT, or ADAPTIVE" - write(*,*) "Using default value of ADAPTIVE" - param%interaction_loops = "ADAPTIVE" - param%ladaptive_interactions = .true. - param%lflatten_interactions = .true. - call io_log_start(param, INTERACTION_TIMER_LOG_OUT, "Interaction loop timer logfile") - call io_log_one_message(INTERACTION_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, nplpl, metric") - end select - - select case(trim(adjustl(param%encounter_check_plpl))) - case("ADAPTIVE") - param%ladaptive_encounters_plpl = .true. - param%lencounter_sas_plpl = .true. - call io_log_start(param, ENCOUNTER_PLPL_TIMER_LOG_OUT, "Encounter check loop timer logfile") - call io_log_one_message(ENCOUNTER_PLPL_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, nplpl, metric") - case("TRIANGULAR") - param%ladaptive_encounters_plpl = .false. - param%lencounter_sas_plpl = .false. - case("SORTSWEEP") - param%ladaptive_encounters_plpl = .false. - param%lencounter_sas_plpl = .true. - case default - write(*,*) "Unknown value for parameter ENCOUNTER_CHECK_PLPL: -> ",trim(adjustl(param%encounter_check_plpl)) - write(*,*) "Must be one of the following: TRIANGULAR, SORTSWEEP, or ADAPTIVE" - write(*,*) "Using default value of ADAPTIVE" - param%encounter_check_plpl = "ADAPTIVE" - param%ladaptive_encounters_plpl = .true. - param%lencounter_sas_plpl = .true. - call io_log_start(param, ENCOUNTER_PLPL_TIMER_LOG_OUT, "Encounter check loop timer logfile") - call io_log_one_message(ENCOUNTER_PLPL_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, nplpl, metric") - end select - - select case(trim(adjustl(param%encounter_check_pltp))) - case("ADAPTIVE") - param%ladaptive_encounters_pltp = .true. - param%lencounter_sas_pltp = .true. - call io_log_start(param, ENCOUNTER_PLTP_TIMER_LOG_OUT, "Encounter check loop timer logfile") - call io_log_one_message(ENCOUNTER_PLTP_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, npltp, metric") - case("TRIANGULAR") - param%ladaptive_encounters_pltp = .false. - param%lencounter_sas_pltp = .false. - case("SORTSWEEP") - param%ladaptive_encounters_pltp = .false. - param%lencounter_sas_pltp = .true. - case default - write(*,*) "Unknown value for parameter ENCOUNTER_CHECK_PLTP: -> ",trim(adjustl(param%encounter_check_pltp)) - write(*,*) "Must be one of the following: TRIANGULAR, SORTSWEEP, or ADAPTIVE" - write(*,*) "Using default value of ADAPTIVE" - param%encounter_check_pltp = "ADAPTIVE" - param%ladaptive_encounters_pltp = .true. - param%lencounter_sas_pltp = .true. - call io_log_start(param, ENCOUNTER_PLTP_TIMER_LOG_OUT, "Encounter check loop timer logfile") - call io_log_one_message(ENCOUNTER_PLTP_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, npltp, metric") - end select - - iostat = 0 - - ! Print the contents of the parameter file to standard output - call param%writer(unit = OUTPUT_UNIT, iotype = "none", v_list = [0], iostat = iostat, iomsg = iomsg) - - end associate - - return - 667 continue - write(*,*) "Error reading param file: ", trim(adjustl(iomsg)) - end subroutine io_param_reader - - - module subroutine io_param_writer(self, unit, iotype, v_list, iostat, iomsg) - !! author: David A. Minton - !! - !! Dump integration parameters to file - !! - !! Adapted from David E. Kaufmann's Swifter routine io_dump_param.f90 - !! Adapted from Martin Duncan's Swift routine io_dump_param.f - implicit none - ! Arguments - class(swiftest_parameters),intent(in) :: self !! Collection of parameters - integer, 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, intent(in) :: v_list(:) !! Not used in this procedure - integer, intent(out) :: iostat !! IO status code - character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 - ! Internals - character(*),parameter :: Ifmt = '(I0)' !! Format label for integer values - character(*),parameter :: Rfmt = '(ES25.17)' !! Format label for real values - character(*),parameter :: Lfmt = '(L1)' !! Format label for logical values - - associate(param => self) - call io_param_writer_one("T0", param%t0, unit) - call io_param_writer_one("TSTOP", param%tstop, unit) - call io_param_writer_one("DT", param%dt, unit) - call io_param_writer_one("IN_TYPE", param%in_type, unit) - if ((param%in_type == REAL4_TYPE) .or. (param%in_type == REAL8_TYPE)) then - call io_param_writer_one("CB_IN", param%incbfile, unit) - call io_param_writer_one("PL_IN", param%inplfile, unit) - call io_param_writer_one("TP_IN", param%intpfile, unit) - else if ((param%in_type == NETCDF_FLOAT_TYPE) .or. (param%in_type == NETCDF_DOUBLE_TYPE)) then - call io_param_writer_one("NC_IN", param%in_netcdf, unit) - end if - - call io_param_writer_one("IN_FORM", param%in_form, unit) - if (param%istep_dump > 0) call io_param_writer_one("ISTEP_DUMP",param%istep_dump, unit) - if (param%istep_out > 0) then - call io_param_writer_one("ISTEP_OUT", param%istep_out, unit) - call io_param_writer_one("BIN_OUT", param%outfile, unit) - call io_param_writer_one("OUT_TYPE", param%out_type, unit) - call io_param_writer_one("OUT_FORM", param%out_form, unit) - call io_param_writer_one("OUT_STAT", "APPEND", unit) - end if - if ((param%out_type == REAL4_TYPE) .or. (param%out_type == REAL8_TYPE)) then - call io_param_writer_one("PARTICLE_OUT", param%particle_out, unit) - end if - if (param%enc_out /= "") then - call io_param_writer_one("ENC_OUT", param%enc_out, unit) - end if - call io_param_writer_one("CHK_RMIN", param%rmin, unit) - call io_param_writer_one("CHK_RMAX", param%rmax, unit) - call io_param_writer_one("CHK_EJECT", param%rmaxu, unit) - call io_param_writer_one("CHK_QMIN", param%qmin, unit) - if (param%qmin >= 0.0_DP) then - call io_param_writer_one("CHK_QMIN_COORD", param%qmin_coord, unit) - call io_param_writer_one("CHK_QMIN_RANGE", [param%qmin_alo, param%qmin_ahi], unit) - end if - call io_param_writer_one("MU2KG", param%MU2KG, unit) - call io_param_writer_one("TU2S", param%TU2S , unit) - call io_param_writer_one("DU2M", param%DU2M, unit) - call io_param_writer_one("RHILL_PRESENT", param%lrhill_present, unit) - call io_param_writer_one("EXTRA_FORCE", param%lextra_force, unit) - if (param%discard_out /= "") then - call io_param_writer_one("DISCARD_OUT", param%discard_out, unit) - end if - if (param%discard_out /= "") then - call io_param_writer_one("BIG_DISCARD", param%lbig_discard, unit) - end if - call io_param_writer_one("CHK_CLOSE", param%lclose, unit) - call io_param_writer_one("ENERGY", param%lenergy, unit) - if (param%lenergy .and. (param%energy_out /= "")) then - call io_param_writer_one("ENERGY_OUT", param%energy_out, unit) - end if - call io_param_writer_one("GR", param%lgr, unit) - call io_param_writer_one("ROTATION", param%lrotation, unit) - call io_param_writer_one("TIDES", param%ltides, unit) - call io_param_writer_one("INTERACTION_LOOPS", param%interaction_loops, unit) - call io_param_writer_one("ENCOUNTER_CHECK_PLPL", param%encounter_check_plpl, unit) - call io_param_writer_one("ENCOUNTER_CHECK_PLTP", param%encounter_check_pltp, unit) - - if (param%lenergy) then - call io_param_writer_one("FIRSTENERGY", param%lfirstenergy, unit) - if ((param%out_type == REAL8_TYPE) .or. (param%out_type == REAL4_TYPE)) then - call io_param_writer_one("EORBIT_ORIG", param%Eorbit_orig, unit) - call io_param_writer_one("GMTOT_ORIG", param%GMtot_orig, unit) - call io_param_writer_one("LTOT_ORIG", param%Ltot_orig(:), unit) - call io_param_writer_one("LORBIT_ORIG", param%Lorbit_orig(:), unit) - call io_param_writer_one("LSPIN_ORIG", param%Lspin_orig(:), unit) - call io_param_writer_one("LESCAPE", param%Lescape(:), unit) - call io_param_writer_one("GMESCAPE",param%GMescape, unit) - call io_param_writer_one("ECOLLISIONS",param%Ecollisions, unit) - call io_param_writer_one("EUNTRACKED",param%Euntracked, unit) - end if - end if - call io_param_writer_one("FIRSTKICK",param%lfirstkick, unit) - call io_param_writer_one("MAXID",param%maxid, unit) - call io_param_writer_one("MAXID_COLLISION",param%maxid_collision, unit) - - iostat = 0 - iomsg = "UDIO not implemented" - end associate - - 667 continue - return - end subroutine io_param_writer - - - module subroutine io_param_writer_one_char(param_name, param_value, unit) - !! author: David A. Minton - !! - !! Writes a single parameter name/value pair to a file unit. - !! This version is for character param_value type - implicit none - ! Arguments - 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 - ! Internals - character(len=NAMELEN) :: param_name_fixed_width !! Parameter label converted to fixed-width string - character(len=STRMAX) :: iomsg !! Message to pass if iostat /= 0 - - write(param_name_fixed_width, *) param_name - write(unit, *, err = 667, iomsg = iomsg) adjustl(param_name_fixed_width) // " " // trim(adjustl(param_value)) - - return - 667 continue - write(*,*) 'Error writing parameter: ',trim(adjustl(iomsg)) - end subroutine io_param_writer_one_char - - - module subroutine io_param_writer_one_DP(param_name, param_value, unit) - !! author: David A. Minton - !! - !! Writes a single parameter name/value pair to a file unit. - !! This version is for real(DP) param_value type - implicit none - ! Arguments - 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 - ! Internals - character(len=STRMAX) :: param_value_string !! Parameter value converted to a string - character(*),parameter :: Rfmt = '(ES25.17)' !! Format label for real values - - write(param_value_string,Rfmt) param_value - call io_param_writer_one(param_name, param_value_string, unit) - - return - end subroutine io_param_writer_one_DP - - - module subroutine io_param_writer_one_DParr(param_name, param_value, unit) - !! author: David A. Minton - !! - !! Writes a single parameter name/value pair to a file unit. - !! This version is for real(DP) arrays () param_value type - implicit none - ! Arguments - 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 - ! Internals - character(len=STRMAX) :: param_value_string !! Parameter value converted to a string - character(*),parameter :: Rfmt = '(ES25.17)' !! Format label for real values - character(len=25) :: arr_val - integer(I4B) :: i, narr - - narr = size(param_value) - do i = 1, narr - write(arr_val, Rfmt) param_value(i) - if (i == 1) then - write(param_value_string, *) arr_val - else - param_value_string = trim(adjustl(param_value_string)) // " " // arr_val - end if - end do - - call io_param_writer_one(param_name, param_value_string, unit) - - return - end subroutine io_param_writer_one_DParr - - - module subroutine io_param_writer_one_I4B(param_name, param_value, unit) - !! author: David A. Minton - !! - !! Writes a single parameter name/value pair to a file unit. - !! This version is for integer(I4B) param_value type - implicit none - ! Arguments - 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 - ! Internals - character(len=STRMAX) :: param_value_string !! Parameter value converted to a string - character(*),parameter :: Ifmt = '(I0)' !! Format label for integer values - - write(param_value_string,Ifmt) param_value - call io_param_writer_one(param_name, param_value_string, unit) - - return - end subroutine io_param_writer_one_I4B - - - module subroutine io_param_writer_one_I8B(param_name, param_value, unit) - !! author: David A. Minton - !! - !! Writes a single parameter name/value pair to a file unit. - !! This version is for integer(I8B) param_value type - implicit none - ! Arguments - 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 - ! Internals - character(len=STRMAX) :: param_value_string !! Parameter value converted to a string - character(*),parameter :: Ifmt = '(I0)' !! Format label for integer values - - write(param_value_string,Ifmt) param_value - call io_param_writer_one(param_name, param_value_string, unit) - - return - end subroutine io_param_writer_one_I8B - - - module subroutine io_param_writer_one_I4Barr(param_name, param_value, unit) - !! author: David A. Minton - !! - !! Writes a single parameter name/value pair to a file unit. - !! This version is for integer(I4B) arrays param_value type - implicit none - ! Arguments - 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 - ! Internals - character(len=STRMAX) :: param_value_string !! Parameter value converted to a string - character(*),parameter :: Ifmt = '(I0)' !! Format label for integer values - character(len=25) :: arr_val - integer(I4B) :: i, narr - - narr = size(param_value) - do i = 1, narr - write(arr_val, Ifmt) param_value(i) - if (i == 1) then - write(param_value_string, *) trim(adjustl(arr_val)) - else - param_value_string = trim(adjustl(param_value_string)) // " " // trim(adjustl(arr_val)) - end if - end do - - call io_param_writer_one(param_name, param_value_string, unit) - - return - end subroutine io_param_writer_one_I4Barr - - - module subroutine io_param_writer_one_logical(param_name, param_value, unit) - !! author: David A. Minton - !! - !! Writes a single parameter name/value pair to a file unit. - !! This version is for logical param_value type - implicit none - ! Arguments - 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 - ! Internals - character(len=STRMAX) :: param_value_string !! Parameter value converted to a string - character(*),parameter :: Lfmt = '(L1)' !! Format label for logical values - - write(param_value_string,Lfmt) param_value - call io_param_writer_one(param_name, param_value_string, unit) - - return - end subroutine io_param_writer_one_logical - - - module subroutine io_param_writer_one_QP(param_name, param_value, unit) - !! author: David A. Minton - !! - !! Writes a single parameter name/value pair to a file unit. - !! This version is for real(QP) param_value type - implicit none - ! Arguments - 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 - ! Internals - character(len=STRMAX) :: param_value_string !! Parameter value converted to a string - character(*),parameter :: Rfmt = '(ES25.17)' !! Format label for real values - - write(param_value_string,Rfmt) param_value - call io_param_writer_one(param_name, param_value_string, unit) - - return - end subroutine io_param_writer_one_QP - - - module subroutine io_read_in_base(self,param) - !! author: Carlisle A. Wishard and David A. Minton - !! - !! Reads in either a central body, test particle, or massive body object. For the swiftest_body types (non-central body), it allocates array space for them - implicit none - class(swiftest_base), intent(inout) :: self !! Swiftest base object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - - if ((param%in_type == NETCDF_FLOAT_TYPE) .or. (param%in_type == NETCDF_DOUBLE_TYPE)) return ! This method is not used in NetCDF mode, as reading is done for the whole system, not on individual particle types - - select type(self) - class is (swiftest_body) - call io_read_in_body(self, param) - class is (swiftest_cb) - call io_read_in_cb(self, param) - end select - - return - end subroutine io_read_in_base - - - subroutine io_read_in_body(self, param) - !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Read in either test particle or massive body data - !! - !! Adapted from David E. Kaufmann's Swifter routine swiftest_init_pl.f90 and swiftest_init_tp.f90 - !! Adapted from Martin Duncan's Swift routine swiftest_init_pl.f and swiftest_init_tp.f - implicit none - ! Arguments - class(swiftest_body), intent(inout) :: self !! Swiftest particle object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: iu = LUN - integer(I4B) :: i, nbody - logical :: is_ascii - character(len=:), allocatable :: infile - character(STRMAX) :: errmsg - ! Internals - integer(I4B) :: ierr !! Error code: returns 0 if the read is successful - - ! Select the appropriate polymorphic class (test particle or massive body) - - select type(self) - class is (swiftest_pl) - infile = param%inplfile - class is (swiftest_tp) - infile = param%intpfile - end select - - is_ascii = (param%in_type == 'ASCII') - select case(param%in_type) - case(ASCII_TYPE) - open(unit = iu, file = infile, status = 'old', form = 'FORMATTED', err = 667, iomsg = errmsg) - read(iu, *, err = 667, iomsg = errmsg) nbody - case (REAL4_TYPE, REAL8_TYPE) - open(unit=iu, file=infile, status='old', form='UNFORMATTED', err = 667, iomsg = errmsg) - read(iu, err = 667, iomsg = errmsg) nbody - case default - write(errmsg,*) trim(adjustl(param%in_type)) // ' is an unrecognized file type' - goto 667 - end select - - call self%setup(nbody, param) - ierr = 0 - if (nbody > 0) then - ierr = self%read_frame(iu, param) - self%status(:) = ACTIVE - self%lmask(:) = .true. - do i = 1, nbody - call self%info(i)%set_value(status="ACTIVE") - end do - end if - close(iu, err = 667, iomsg = errmsg) - - - if (ierr == 0) return - - 667 continue - write(*,*) 'Error reading in initial conditions file: ',trim(adjustl(errmsg)) - return - end subroutine io_read_in_body - - - subroutine io_read_in_cb(self, param) - !! author: David A. Minton - !! - !! Reads in central body data - !! - !! Adapted from David E. Kaufmann's Swifter routine swiftest_init_pl.f90 - !! Adapted from Martin Duncan's Swift routine swiftest_init_pl.f - implicit none - ! Arguments - class(swiftest_cb), intent(inout) :: self - class(swiftest_parameters), intent(inout) :: param - ! Internals - integer(I4B) :: iu = LUN - character(len=STRMAX) :: errmsg - integer(I4B) :: ierr - character(len=NAMELEN) :: name - - if (param%in_type == 'ASCII') then - self%id = 0 - param%maxid = 0 - open(unit = iu, file = param%incbfile, status = 'old', form = 'FORMATTED', err = 667, iomsg = errmsg) - read(iu, *, err = 667, iomsg = errmsg) name - call self%info%set_value(name=name) - read(iu, *, err = 667, iomsg = errmsg) self%Gmass - self%mass = real(self%Gmass / param%GU, kind=DP) - read(iu, *, err = 667, iomsg = errmsg) self%radius - read(iu, *, err = 667, iomsg = errmsg) self%j2rp2 - read(iu, *, err = 667, iomsg = errmsg) self%j4rp4 - if (param%lrotation) then - read(iu, *, err = 667, iomsg = errmsg) self%Ip(1), self%Ip(2), self%Ip(3) - read(iu, *, err = 667, iomsg = errmsg) self%rot(1), self%rot(2), self%rot(3) - end if - ierr = 0 - else - open(unit = iu, file = param%incbfile, status = 'old', form = 'UNFORMATTED', err = 667, iomsg = errmsg) - ierr = self%read_frame(iu, param) - end if - close(iu, err = 667, iomsg = errmsg) - - if (ierr == 0) then - - if (param%rmin < 0.0) param%rmin = self%radius - - select type(cb => self) - class is (symba_cb) - cb%GM0 = cb%Gmass - cb%dGM = 0.0_DP - cb%R0 = cb%radius - if (param%lrotation) then - cb%L0(:) = cb%Ip(3) * cb%mass * cb%radius**2 * cb%rot(:) - cb%dL(:) = 0.0_DP - end if - end select - end if - return - - 667 continue - write(*,*) "Error reading central body file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_read_in_cb - - - module subroutine io_read_in_system(self, param) - !! author: David A. Minton and Carlisle A. Wishard - !! - !! Reads in the system from input files - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self - class(swiftest_parameters), intent(inout) :: param - ! Internals - integer(I4B) :: ierr - class(swiftest_parameters), allocatable :: tmp_param - - if ((param%in_type == NETCDF_DOUBLE_TYPE) .or. (param%in_type == NETCDF_FLOAT_TYPE)) then - allocate(tmp_param, source=param) - tmp_param%outfile = param%in_netcdf - tmp_param%out_form = param%in_form - if (.not. param%lrestart) then - ! Turn off energy computation so we don't have to feed it into the initial conditions - tmp_param%lenergy = .false. - end if - ierr = self%read_frame(tmp_param%nciu, tmp_param) - deallocate(tmp_param) - if (ierr /=0) call util_exit(FAILURE) - else - call self%cb%read_in(param) - call self%pl%read_in(param) - call self%tp%read_in(param) - ! Copy over param file variable inputs - self%Eorbit_orig = param%Eorbit_orig - self%GMtot_orig = param%GMtot_orig - self%Ltot_orig(:) = param%Ltot_orig(:) - self%Lorbit_orig(:) = param%Lorbit_orig(:) - self%Lspin_orig(:) = param%Lspin_orig(:) - self%Lescape(:) = param%Lescape(:) - self%Ecollisions = param%Ecollisions - self%Euntracked = param%Euntracked - end if - - param%loblatecb = ((self%cb%j2rp2 /= 0.0_DP) .or. (self%cb%j4rp4 /= 0.0_DP)) - if (.not.param%loblatecb) then - if (allocated(self%pl%aobl)) deallocate(self%pl%aobl) - if (allocated(self%tp%aobl)) deallocate(self%tp%aobl) - end if - - return - end subroutine io_read_in_system - - - function io_read_encounter(t, id1, id2, Gmass1, Gmass2, radius1, radius2, & - xh1, xh2, vh1, vh2, enc_out, out_type) result(ierr) - !! author: David A. Minton - !! - !! Read close encounter data from input binary files - !! Other than time t, there is no direct file input from this function - !! Function returns read error status (0 = OK, nonzero = ERROR) - !! Adapted from David E. Kaufmann's Swifter routine: io_read_encounter.f90 - implicit none - ! Arguments - integer(I4B), intent(out) :: id1, id2 - real(DP), intent(out) :: t, Gmass1, Gmass2, radius1, radius2 - real(DP), dimension(:), intent(out) :: xh1, xh2, vh1, vh2 - character(*), intent(in) :: enc_out, out_type - ! Result - integer(I4B) :: ierr - ! Internals - logical , save :: lfirst = .true. - integer(I4B), save :: iu = lun - - if (lfirst) then - open(unit = iu, file = enc_out, status = 'OLD', form = 'UNFORMATTED', iostat = ierr) - if (ierr /= 0) then - write(*, *) "Swiftest Error:" - write(*, *) " unable to open binary encounter file" - call util_exit(FAILURE) - end if - lfirst = .false. - end if - read(iu, iostat = ierr) t - if (ierr /= 0) then - close(unit = iu, iostat = ierr) - return - end if - - read(iu, iostat = ierr) id1, xh1(1), xh1(2), xh1(3), vh1(1), vh1(2), vh1(3), Gmass1, radius1 - if (ierr /= 0) then - close(unit = iu, iostat = ierr) - return - end if - read(iu, iostat = ierr) id2, xh2(2), xh2(2), xh2(3), vh2(2), vh2(2), vh2(3), Gmass2, radius2 - if (ierr /= 0) then - close(unit = iu, iostat = ierr) - return - end if - - return - end function io_read_encounter - - - module function io_read_frame_body(self, iu, param) result(ierr) - !! author: David A. Minton - !! - !! Reads a frame of output of either test particle or massive body data from a binary output file - !! - !! Adapted from David E. Kaufmann's Swifter routine io_read_frame.f90 - !! Adapted from Hal Levison's Swift routine io_read_frame.F - implicit none - ! Arguments - class(swiftest_body), intent(inout) :: self !! Swiftest particle 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 - ! Result - integer(I4B) :: ierr !! Error code: returns 0 if the read is successful - ! Internals - character(len=STRMAX) :: errmsg - character(len=NAMELEN), dimension(self%nbody) :: name - integer(I4B) :: i - real(QP) :: val - - if (self%nbody == 0) return - - if ((param%in_form /= EL) .and. (param%in_form /= XV)) then - write(errmsg, *) trim(adjustl(param%in_form)) // " is not a recognized format code for input files." - goto 667 - end if - - associate(n => self%nbody) - - if (param%in_form == EL) then - if (.not.allocated(self%a)) allocate(self%a(n)) - if (.not.allocated(self%e)) allocate(self%e(n)) - if (.not.allocated(self%inc)) allocate(self%inc(n)) - if (.not.allocated(self%capom)) allocate(self%capom(n)) - if (.not.allocated(self%omega)) allocate(self%omega(n)) - if (.not.allocated(self%capm)) allocate(self%capm(n)) - end if - - select case(param%in_type) - case (REAL4_TYPE, REAL8_TYPE) - read(iu, err = 667, iomsg = errmsg) self%id(:) - read(iu, err = 667, iomsg = errmsg) name(:) - do i = 1, n - call self%info(i)%set_value(name=name(i)) - end do - - select case (param%in_form) - case (XV) - read(iu, err = 667, iomsg = errmsg) self%xh(1, :) - read(iu, err = 667, iomsg = errmsg) self%xh(2, :) - read(iu, err = 667, iomsg = errmsg) self%xh(3, :) - read(iu, err = 667, iomsg = errmsg) self%vh(1, :) - read(iu, err = 667, iomsg = errmsg) self%vh(2, :) - read(iu, err = 667, iomsg = errmsg) self%vh(3, :) - case (EL) - read(iu, err = 667, iomsg = errmsg) self%a(:) - read(iu, err = 667, iomsg = errmsg) self%e(:) - read(iu, err = 667, iomsg = errmsg) self%inc(:) - read(iu, err = 667, iomsg = errmsg) self%capom(:) - read(iu, err = 667, iomsg = errmsg) self%omega(:) - read(iu, err = 667, iomsg = errmsg) self%capm(:) - end select - - select type(pl => self) - class is (swiftest_pl) ! Additional output if the passed polymorphic object is a massive body - read(iu, err = 667, iomsg = errmsg) pl%Gmass(:) - pl%mass(:) = pl%Gmass(:) / param%GU - if (param%lrhill_present) read(iu, err = 667, iomsg = errmsg) pl%rhill(:) - if (param%lclose) read(iu, err = 667, iomsg = errmsg) pl%radius(:) - if (param%lrotation) then - read(iu, err = 667, iomsg = errmsg) pl%Ip(1, :) - read(iu, err = 667, iomsg = errmsg) pl%Ip(2, :) - read(iu, err = 667, iomsg = errmsg) pl%Ip(3, :) - read(iu, err = 667, iomsg = errmsg) pl%rot(1, :) - read(iu, err = 667, iomsg = errmsg) pl%rot(2, :) - read(iu, err = 667, iomsg = errmsg) pl%rot(3, :) - end if - ! if (param%ltides) then - ! read(iu, err = 667, iomsg = errmsg) pl%k2(:) - ! read(iu, err = 667, iomsg = errmsg) pl%Q(:) - ! end if - end select - - param%maxid = max(param%maxid, maxval(self%id(1:n))) - - case (ASCII_TYPE) - do i = 1, n - select type(self) - class is (swiftest_pl) - if (param%lrhill_present) then - read(iu, *, err = 667, iomsg = errmsg) name(i), val, self%rhill(i) - else - read(iu, *, err = 667, iomsg = errmsg) name(i), val - end if - self%Gmass(i) = real(val, kind=DP) - self%mass(i) = real(val / param%GU, kind=DP) - if (param%lclose) read(iu, *, err = 667, iomsg = errmsg) self%radius(i) - class is (swiftest_tp) - read(iu, *, err = 667, iomsg = errmsg) name(i) - end select - call self%info(i)%set_value(name=name(i)) - - select case(param%in_form) - case (XV) - read(iu, *, err = 667, iomsg = errmsg) self%xh(1, i), self%xh(2, i), self%xh(3, i) - read(iu, *, err = 667, iomsg = errmsg) self%vh(1, i), self%vh(2, i), self%vh(3, i) - case (EL) - read(iu, *, err = 667, iomsg = errmsg) self%a(i), self%e(i), self%inc(i) - read(iu, *, err = 667, iomsg = errmsg) self%capom(i), self%omega(i), self%capm(i) - end select - - select type (self) - class is (swiftest_pl) - if (param%lrotation) then - read(iu, *, err = 667, iomsg = errmsg) self%Ip(1, i), self%Ip(2, i), self%Ip(3, i) - read(iu, *, err = 667, iomsg = errmsg) self%rot(1, i), self%rot(2, i), self%rot(3, i) - end if - ! if (param%ltides) then - ! read(iu, *, err = 667, iomsg = errmsg) self%k2(i) - ! read(iu, *, err = 667, iomsg = errmsg) self%Q(i) - ! end if - end select - param%maxid = param%maxid + 1 - self%id(i) = param%maxid - end do - end select - - if (param%in_form == EL) then - self%inc(1:n) = self%inc(1:n) * DEG2RAD - self%capom(1:n) = self%capom(1:n) * DEG2RAD - self%omega(1:n) = self%omega(1:n) * DEG2RAD - self%capm(1:n) = self%capm(1:n) * DEG2RAD - end if - end associate - - ierr = 0 - return - - 667 continue - select type (self) - class is (swiftest_pl) - write(*,*) "Error reading massive body file: " // trim(adjustl(errmsg)) - class is (swiftest_tp) - write(*,*) "Error reading test particle file: " // trim(adjustl(errmsg)) - class default - write(*,*) "Error reading body file: " // trim(adjustl(errmsg)) - end select - call util_exit(FAILURE) - end function io_read_frame_body - - - module function io_read_frame_cb(self, iu, param) result(ierr) - !! author: David A. Minton - !! - !! Reads a frame of output of central body data to the binary output file - !! - !! Adapted from David E. Kaufmann's Swifter routine io_read_frame.f90 - !! Adapted from Hal Levison's Swift routine io_read_frame.F - implicit none - ! Arguments - class(swiftest_cb), intent(inout) :: self !! Swiftest central 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 - ! Result - integer(I4B) :: ierr !! Error code: returns 0 if the read is successful - ! Internals - character(len=STRMAX) :: errmsg - character(len=NAMELEN) :: name - - read(iu, err = 667, iomsg = errmsg) self%id - read(iu, err = 667, iomsg = errmsg) name - call self%info%set_value(name=name) - read(iu, err = 667, iomsg = errmsg) self%Gmass - self%mass = self%Gmass / param%GU - read(iu, err = 667, iomsg = errmsg) self%radius - read(iu, err = 667, iomsg = errmsg) self%j2rp2 - read(iu, err = 667, iomsg = errmsg) self%j4rp4 - if (param%lrotation) then - read(iu, err = 667, iomsg = errmsg) self%Ip(1) - read(iu, err = 667, iomsg = errmsg) self%Ip(2) - read(iu, err = 667, iomsg = errmsg) self%Ip(3) - read(iu, err = 667, iomsg = errmsg) self%rot(1) - read(iu, err = 667, iomsg = errmsg) self%rot(2) - read(iu, err = 667, iomsg = errmsg) self%rot(3) - end if - ! if (param%ltides) then - ! read(iu, err = 667, iomsg = errmsg) self%k2 - ! read(iu, err = 667, iomsg = errmsg) self%Q - ! end if - - ierr = 0 - return - - 667 continue - write(*,*) "Error reading central body frame: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end function io_read_frame_cb - - - module function io_read_frame_system(self, iu, param) result(ierr) - !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Read a frame (header plus records for each massive body and active test particle) from a output binary file - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system 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 - ! Result - integer(I4B) :: ierr !! Error code: returns 0 if the read is successful - ! Internals - character(len=STRMAX) :: errmsg - integer(I4B) :: npl, ntp - - ierr = io_read_hdr(iu, param%t, npl, ntp, param%out_form, param%out_type) - if (is_iostat_end(ierr)) return ! Reached the end of the frames - call self%pl%setup(npl, param) - call self%tp%setup(ntp, param) - - if (ierr /= 0) then - write(errmsg, *) "Cannot read frame header." - goto 667 - end if - ierr = self%cb%read_frame(iu, param) - if (ierr /= 0) then - write(errmsg, *) "Cannot read central body frame." - goto 667 - end if - ierr = self%pl%read_frame(iu, param) - if (ierr /= 0) then - write(errmsg, *) "Cannot read massive body frame." - goto 667 - end if - ierr = self%tp%read_frame(iu, param) - if (ierr /= 0) then - write(errmsg, *) "Cannot read test particle frame." - goto 667 - end if - - return - - 667 continue - write(*,*) "Error reading system frame: " // trim(adjustl(errmsg)) - end function io_read_frame_system - - - function io_read_hdr(iu, t, npl, ntp, out_form, out_type) result(ierr) - !! author: David A. Minton - !! - !! Read frame header from input binary files - !! Function returns read error status (0 = OK, nonzero = ERROR) - !! Adapted from David E. Kaufmann's Swifter routine: io_read_hdr.f90 - !! Adapted from Hal Levison's Swift routine io_read_hdr.f - implicit none - ! Arguments - integer(I4B), intent(in) :: iu - integer(I4B), intent(out) :: npl, ntp - character(*), intent(out) :: out_form - real(DP), intent(out) :: t - character(*), intent(in) :: out_type - ! Result - integer(I4B) :: ierr - ! Internals - real(SP) :: ttmp - character(len=STRMAX) :: errmsg - - select case (out_type) - case (REAL4_TYPE) - read(iu, iostat = ierr, err = 667, iomsg = errmsg, end = 333) ttmp - t = ttmp - case (REAL8_TYPE) - read(iu, iostat = ierr, err = 667, iomsg = errmsg, end = 333) t - case default - write(errmsg,*) trim(adjustl(out_type)) // ' is an unrecognized file type' - ierr = -1 - end select - read(iu, iostat = ierr, err = 667, iomsg = errmsg) npl - read(iu, iostat = ierr, err = 667, iomsg = errmsg) ntp - read(iu, iostat = ierr, err = 667, iomsg = errmsg) out_form - - return - - 667 continue - write(*,*) "Error reading header: " // trim(adjustl(errmsg)) - 333 continue - return - - return - end function io_read_hdr - - - module subroutine io_read_in_param(self, param_file_name) - !! author: David A. Minton - !! - !! Read in parameters for the integration - !! - !! Adapted from David E. Kaufmann's Swifter routine io_init_param.f90 - !! Adapted from Martin Duncan's Swift routine io_init_param.f - implicit none - ! Arguments - 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) - ! Internals - integer(I4B) :: ierr = 0 !! Input error code - character(STRMAX) :: errmsg !! Error message in UDIO procedure - - ! Read in name of parameter file - write(*, *) 'Parameter input file is ', trim(adjustl(param_file_name)) - write(*, *) ' ' - self%param_file_name = param_file_name - - !! todo: Currently this procedure does not work in user-defined derived-type input mode - !! as the newline characters are ignored in the input file when compiled in ifort. - - !read(LUN,'(DT)', iostat= ierr, iomsg = errmsg) self - call self%reader(LUN, iotype= "none", v_list = [self%integrator], iostat = ierr, iomsg = errmsg) - if (ierr == 0) return - - 667 continue - write(*,*) "Error reading parameter file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_read_in_param - - - module subroutine io_read_in_particle_info(self, iu) - !! author: David A. Minton - !! - !! Reads in particle information object information from an open file unformatted file - implicit none - ! Arguments - class(swiftest_particle_info), intent(inout) :: self !! Particle metadata information object - integer(I4B), intent(in) :: iu !! Open file unit number - ! Internals - character(STRMAX) :: errmsg - - read(iu, err = 667, iomsg = errmsg) self%name - read(iu, err = 667, iomsg = errmsg) self%particle_type - read(iu, err = 667, iomsg = errmsg) self%origin_type - read(iu, err = 667, iomsg = errmsg) self%origin_time - read(iu, err = 667, iomsg = errmsg) self%collision_id - read(iu, err = 667, iomsg = errmsg) self%origin_xh(:) - read(iu, err = 667, iomsg = errmsg) self%origin_vh(:) - - return - - 667 continue - write(*,*) "Error reading particle metadata information from file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_read_in_particle_info - - - module subroutine io_read_particle_info_system(self, param) - !! author: David A. Minton - !! - !! Reads an old particle information file for a restartd run - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: id, idx - logical :: lmatch - character(STRMAX) :: errmsg - type(swiftest_particle_info), allocatable :: tmpinfo - - if (.not.((param%out_type == REAL4_TYPE) .or. (param%out_type == REAL8_TYPE))) return ! This subroutine is only necessary for classic binary input files - - open(unit = LUN, file = param%particle_out, status = 'OLD', form = 'UNFORMATTED', err = 667, iomsg = errmsg) - - allocate(tmpinfo, mold=self%cb%info) - - select type(cb => self%cb) - class is (swiftest_cb) - select type(pl => self%pl) - class is (swiftest_pl) - select type(tp => self%tp) - class is (swiftest_tp) - associate(npl => pl%nbody, ntp => tp%nbody) - do - lmatch = .false. - read(LUN, err = 667, iomsg = errmsg, end = 333) id - - if (id == cb%id) then - call cb%info%read_in(LUN) - lmatch = .true. - else - if (npl > 0) then - idx = findloc(pl%id(1:npl), id, dim=1) - if (idx /= 0) then - call pl%info(idx)%read_in(LUN) - lmatch = .true. - end if - end if - if (.not.lmatch .and. ntp > 0) then - idx = findloc(tp%id(1:ntp), id, dim=1) - if (idx /= 0) then - call tp%info(idx)%read_in(LUN) - lmatch = .true. - end if - end if - end if - if (.not.lmatch) then - call tmpinfo%read_in(LUN) - end if - end do - end associate - close(unit = LUN, err = 667, iomsg = errmsg) - end select - end select - end select - - 333 continue - return - - 667 continue - write(*,*) "Error reading particle information file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_read_particle_info_system - - - module subroutine io_toupper(string) - !! author: David A. Minton - !! - !! Convert string to uppercase - !! - !! Adapted from David E. Kaufmann's Swifter routine: util_toupper.f90 - implicit none - ! Arguments - character(*), intent(inout) :: string !! String to make upper case - ! Internals - integer(I4B) :: i, length, idx - - length = len(string) - do i = 1, length - idx = iachar(string(i:i)) - if ((idx >= lowercase_begin) .and. (idx <= lowercase_end)) then - idx = idx + uppercase_offset - string(i:i) = achar(idx) - end if - end do - - return - end subroutine io_toupper - - - module subroutine io_write_discard(self, param) - !! author: David A. Minton - !! - !! Write out information about discarded test particle - !! - !! Adapted from David E. Kaufmann's Swifter routine io_discard_write.f90 - !! Adapted from Hal Levison's Swift routine io_discard_write.f - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i - logical, save :: lfirst = .true. - real(DP), dimension(:,:), allocatable :: vh - character(*), parameter :: HDRFMT = '(E23.16, 1X, I8, 1X, L1)' - character(*), parameter :: NAMEFMT = '(A, 2(1X, I8))' - character(*), parameter :: VECFMT = '(3(E23.16, 1X))' - character(*), parameter :: NPLFMT = '(I8)' - character(*), parameter :: PLNAMEFMT = '(I8, 2(1X, E23.16))' - class(swiftest_body), allocatable :: pltemp - character(len=STRMAX) :: errmsg, out_stat - - associate(tp_discards => self%tp_discards, nsp => self%tp_discards%nbody, pl => self%pl, npl => self%pl%nbody) - - ! Record the discarded body metadata information to file - if ((param%out_type == NETCDF_FLOAT_TYPE) .or. (param%out_type == NETCDF_DOUBLE_TYPE)) then - call tp_discards%write_particle_info(param%nciu, param) - end if - - if (param%discard_out == "") return - - if (nsp == 0) return - if (lfirst) then - out_stat = param%out_stat - else - out_stat = 'APPEND' - end if - select case(out_stat) - case('APPEND') - open(unit=LUN, file=param%discard_out, status='OLD', position='APPEND', form='FORMATTED', err=667, iomsg=errmsg) - case('NEW', 'REPLACE', 'UNKNOWN') - open(unit=LUN, file=param%discard_out, status=param%out_stat, form='FORMATTED', err=667, iomsg=errmsg) - case default - write(*,*) 'Invalid status code for OUT_STAT: ',trim(adjustl(param%out_stat)) - call util_exit(FAILURE) - end select - lfirst = .false. - if (param%lgr) call tp_discards%pv2v(param) - - write(LUN, HDRFMT) param%t, nsp, param%lbig_discard - do i = 1, nsp - write(LUN, NAMEFMT, err = 667, iomsg = errmsg) SUB, tp_discards%id(i), tp_discards%status(i) - write(LUN, VECFMT, err = 667, iomsg = errmsg) tp_discards%xh(1, i), tp_discards%xh(2, i), tp_discards%xh(3, i) - write(LUN, VECFMT, err = 667, iomsg = errmsg) tp_discards%vh(1, i), tp_discards%vh(2, i), tp_discards%vh(3, i) - end do - if (param%lbig_discard) then - if (param%lgr) then - allocate(pltemp, source = pl) - call pltemp%pv2v(param) - allocate(vh, source = pltemp%vh) - deallocate(pltemp) - else - allocate(vh, source = pl%vh) - end if - - write(LUN, NPLFMT) npl - do i = 1, npl - write(LUN, PLNAMEFMT, err = 667, iomsg = errmsg) pl%id(i), pl%Gmass(i), pl%radius(i) - write(LUN, VECFMT, err = 667, iomsg = errmsg) pl%xh(1, i), pl%xh(2, i), pl%xh(3, i) - write(LUN, VECFMT, err = 667, iomsg = errmsg) vh(1, i), vh(2, i), vh(3, i) - end do - deallocate(vh) - end if - close(LUN) - end associate - - return - - 667 continue - write(*,*) "Error writing discard file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_write_discard - - - module subroutine io_write_frame_body(self, iu, param) - !! author: David A. Minton - !! - !! Write a frame of output of either test particle or massive body data to the binary output file - !! Note: If outputting to orbital elements, but sure that the conversion is done prior to calling this method - !! - !! Adapted from David E. Kaufmann's Swifter routine io_write_frame.f90 - !! Adapted from Hal Levison's Swift routine io_write_frame.F - implicit none - ! Arguments - class(swiftest_body), intent(in) :: self !! Swiftest particle object - integer(I4B), intent(inout) :: iu !! Unit number for the output file to write frame to - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - ! Internals - character(len=STRMAX) :: errmsg - - associate(n => self%nbody) - if (n == 0) return - write(iu, err = 667, iomsg = errmsg) self%id(1:n) - write(iu, err = 667, iomsg = errmsg) self%info(1:n)%name - if ((param%out_form == XV) .or. (param%out_form == XVEL)) then - write(iu, err = 667, iomsg = errmsg) self%xh(1, 1:n) - write(iu, err = 667, iomsg = errmsg) self%xh(2, 1:n) - write(iu, err = 667, iomsg = errmsg) self%xh(3, 1:n) - write(iu, err = 667, iomsg = errmsg) self%vh(1, 1:n) - write(iu, err = 667, iomsg = errmsg) self%vh(2, 1:n) - write(iu, err = 667, iomsg = errmsg) self%vh(3, 1:n) - end if - if ((param%out_form == EL) .or. (param%out_form == XVEL)) then - write(iu, err = 667, iomsg = errmsg) self%a(1:n) - write(iu, err = 667, iomsg = errmsg) self%e(1:n) - write(iu, err = 667, iomsg = errmsg) self%inc(1:n) * RAD2DEG - write(iu, err = 667, iomsg = errmsg) self%capom(1:n) * RAD2DEG - write(iu, err = 667, iomsg = errmsg) self%omega(1:n) * RAD2DEG - write(iu, err = 667, iomsg = errmsg) self%capm(1:n) * RAD2DEG - end if - select type(pl => self) - class is (swiftest_pl) ! Additional output if the passed polymorphic object is a massive body - write(iu, err = 667, iomsg = errmsg) pl%Gmass(1:n) - if (param%lrhill_present) write(iu, err = 667, iomsg = errmsg) pl%rhill(1:n) - if (param%lclose) write(iu, err = 667, iomsg = errmsg) pl%radius(1:n) - if (param%lrotation) then - write(iu, err = 667, iomsg = errmsg) pl%Ip(1, 1:n) - write(iu, err = 667, iomsg = errmsg) pl%Ip(2, 1:n) - write(iu, err = 667, iomsg = errmsg) pl%Ip(3, 1:n) - write(iu, err = 667, iomsg = errmsg) pl%rot(1, 1:n) - write(iu, err = 667, iomsg = errmsg) pl%rot(2, 1:n) - write(iu, err = 667, iomsg = errmsg) pl%rot(3, 1:n) - end if - ! if (param%ltides) then - ! write(iu, err = 667, iomsg = errmsg) pl%k2(1:n) - ! write(iu, err = 667, iomsg = errmsg) pl%Q(1:n) - ! end if - end select - end associate - - return - 667 continue - write(*,*) "Error writing body frame: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_write_frame_body - - - module subroutine io_write_frame_cb(self, iu, param) - !! author: David A. Minton - !! - !! Write a frame of output of central body data to the binary output file - !! - !! Adapted from David E. Kaufmann's Swifter routine io_write_frame.f90 - !! Adapted from Hal Levison's Swift routine io_write_frame.F - implicit none - ! Arguments - class(swiftest_cb), intent(in) :: self !! Swiftest central body object - integer(I4B), intent(inout) :: iu !! Unit number for the output file to write frame to - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - ! Internals - character(len=STRMAX) :: errmsg - - associate(cb => self) - write(iu, err = 667, iomsg = errmsg) cb%id - write(iu, err = 667, iomsg = errmsg) cb%info%name - write(iu, err = 667, iomsg = errmsg) cb%Gmass - write(iu, err = 667, iomsg = errmsg) cb%radius - write(iu, err = 667, iomsg = errmsg) cb%j2rp2 - write(iu, err = 667, iomsg = errmsg) cb%j4rp4 - if (param%lrotation) then - write(iu, err = 667, iomsg = errmsg) cb%Ip(1) - write(iu, err = 667, iomsg = errmsg) cb%Ip(2) - write(iu, err = 667, iomsg = errmsg) cb%Ip(3) - write(iu, err = 667, iomsg = errmsg) cb%rot(1) - write(iu, err = 667, iomsg = errmsg) cb%rot(2) - write(iu, err = 667, iomsg = errmsg) cb%rot(3) - end if - ! if (param%ltides) then - ! write(iu, err = 667, iomsg = errmsg) cb%k2 - ! write(iu, err = 667, iomsg = errmsg) cb%Q - ! end if - end associate - - return - 667 continue - write(*,*) "Error writing central body frame: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_write_frame_cb - - - module subroutine io_write_frame_system(self, param) - !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Write a frame (header plus records for each massive body and active test particle) to output binary file - !! There is no direct file output from this subroutine - !! - !! Adapted from David E. Kaufmann's Swifter routine io_write_frame.f90 - !! Adapted from Hal Levison's Swift routine io_write_frame.F - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - logical, save :: lfirst = .true. !! Flag to determine if this is the first call of this method - class(swiftest_cb), allocatable :: cb !! Temporary local version of pl structure used for non-destructive conversions - class(swiftest_pl), allocatable :: pl !! Temporary local version of pl structure used for non-destructive conversions - class(swiftest_tp), allocatable :: tp !! Temporary local version of pl structure used for non-destructive conversions - character(len=STRMAX) :: errmsg - integer(I4B) :: iu = BINUNIT !! Unit number for the output file to write frame to - logical :: fileExists - - allocate(cb, source = self%cb) - allocate(pl, source = self%pl) - allocate(tp, source = self%tp) - iu = BINUNIT - - if ((param%out_type == REAL4_TYPE) .or. (param%out_type == REAL8_TYPE)) then - if (lfirst) then - select case(param%out_stat) - case('APPEND') - open(unit=iu, file=param%outfile, status='OLD', position='APPEND', form='UNFORMATTED', err=667, iomsg=errmsg) - case('NEW', 'REPLACE', 'UNKNOWN') - open(unit=iu, file=param%outfile, status=param%out_stat, form='UNFORMATTED', err=667, iomsg=errmsg) - case default - write(*,*) 'Invalid status code for OUT_STAT: ',trim(adjustl(param%out_stat)) - call util_exit(FAILURE) - end select - - lfirst = .false. - else - open(unit=iu, file=param%outfile, status='OLD', position= 'APPEND', form='UNFORMATTED', err=667, iomsg=errmsg) - end if - else if ((param%out_type == NETCDF_FLOAT_TYPE) .or. (param%out_type == NETCDF_DOUBLE_TYPE)) then - - param%nciu%id_chunk = pl%nbody + tp%nbody - param%nciu%time_chunk = max(param%istep_dump / param%istep_out, 1) - if (lfirst) then - inquire(file=param%outfile, exist=fileExists) - - select case(param%out_stat) - case('APPEND') - if (.not.fileExists) then - errmsg = param%outfile // " not found! You must specify OUT_STAT = NEW, REPLACE, or UNKNOWN" - goto 667 - end if - case('NEW') - if (fileExists) then - errmsg = param%outfile // " Alread Exists! You must specify OUT_STAT = APPEND, REPLACE, or UNKNOWN" - goto 667 - end if - call param%nciu%initialize(param) - case('REPLACE', 'UNKNOWN') - call param%nciu%initialize(param) - end select - - lfirst = .false. - end if - end if - - ! Write out each data type frame - if ((param%out_type == REAL4_TYPE) .or. (param%out_type == REAL8_TYPE)) then - ! For these data types, do these conversion here before writing the output. - if (param%lgr) then - call pl%pv2v(param) - call tp%pv2v(param) - end if - - if ((param%out_form == EL) .or. (param%out_form == XVEL)) then ! Do an orbital element conversion prior to writing out the frame, as we have access to the central body here - call pl%xv2el(cb) - call tp%xv2el(cb) - end if - - call self%write_hdr(iu, param) - call cb%write_frame(iu, param) - call pl%write_frame(iu, param) - call tp%write_frame(iu, param) - close(iu, err = 667, iomsg = errmsg) - else if ((param%out_type == NETCDF_FLOAT_TYPE) .or. (param%out_type == NETCDF_DOUBLE_TYPE)) then - ! For NetCDF output, because we want to store the pseudovelocity separately from the true velocity, we need to do the orbital element conversion internally - call self%write_hdr(param%nciu, param) - call cb%write_frame(param%nciu, param) - call pl%write_frame(param%nciu, param) - call tp%write_frame(param%nciu, param) - end if - - return - - 667 continue - write(*,*) "Error writing system frame: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_write_frame_system - - - module subroutine io_write_hdr_system(self, iu, param) ! t, npl, ntp, out_form, out_type) - !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Write frame header to output binary file - !! - !! Adapted from David Adapted from David E. Kaufmann's Swifter routine io_write_hdr.f90 - !! Adapted from Hal Levison's Swift routine io_write_hdr.F - implicit none - ! Arguments - class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object - integer(I4B), intent(inout) :: iu !! Output file unit number - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - ! Internals - character(len=STRMAX) :: errmsg - - select case (param%out_type) - case (REAL4_TYPE) - write(iu, err = 667, iomsg = errmsg) real(param%t, kind=SP) - case (REAL8_TYPE) - write(iu, err = 667, iomsg = errmsg) param%t - end select - write(iu, err = 667, iomsg = errmsg) self%pl%nbody - write(iu, err = 667, iomsg = errmsg) self%tp%nbody - write(iu, err = 667, iomsg = errmsg) param%out_form - - return - - 667 continue - write(*,*) "Error writing header: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_write_hdr_system - -end submodule s_io diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 deleted file mode 100644 index 467403269..000000000 --- a/src/main/swiftest_driver.f90 +++ /dev/null @@ -1,141 +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. - -program swiftest_driver - !! author: David A. Minton - !! - !! Driver program for the Swiftest integrators. Unlike the earlier Swift and Swifter drivers, in Swiftest all integrators - !! are run from this single program. - !! - !! Adapted from Swifter by David E. Kaufmann's Swifter driver programs swifter_[bs,helio,ra15,rmvs,symba,tu4,whm].f90 - !! Adapted from Hal Levison and Martin Duncan's Swift driver programs - use swiftest - implicit none - - class(swiftest_nbody_system), allocatable :: nbody_system !! Polymorphic object containing the nbody system to be integrated - class(swiftest_parameters), allocatable :: param !! Run configuration parameters - integer(I4B) :: integrator !! Integrator type code (see swiftest_globals for symbolic names) - character(len=:),allocatable :: param_file_name !! Name of the file containing user-defined parameters - integer(I4B) :: ierr !! I/O error code - integer(I8B) :: iloop !! Loop counter - integer(I8B) :: idump !! Dump cadence counter - integer(I8B) :: iout !! Output cadence counter - integer(I8B) :: ioutput_t0 !! The output frame counter at time 0 - integer(I8B) :: nloops !! Number of steps to take in the simulation - real(DP) :: old_t_final = 0.0_DP !! Output time at which writing should start, in order to prevent duplicate lines being written for restarts - type(walltimer) :: integration_timer !! Object used for computing elapsed wall time - real(DP) :: tfrac - character(*), parameter :: statusfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & - '"; Number of active pl, tp = ", I5, ", ", I5)' - character(*), parameter :: symbastatfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & - '"; Number of active plm, pl, tp = ", I5, ", ", I5, ", ", I5)' - - ierr = io_get_args(integrator, param_file_name) - if (ierr /= 0) then - write(*,*) 'Error reading in arguments from the command line' - call util_exit(FAILURE) - end if - !> Read in the user-defined parameters file and the initial conditions of the system - select case(integrator) - case(symba) - allocate(symba_parameters :: param) - case default - allocate(swiftest_parameters :: param) - end select - param%integrator = integrator - - call setup_construct_system(nbody_system, param) - call param%read_in(param_file_name) - - associate(t => param%t, & - t0 => param%t0, & - dt => param%dt, & - tstop => param%tstop, & - istep_out => param%istep_out, & - istep_dump => param%istep_dump, & - ioutput => param%ioutput) - - call nbody_system%initialize(param) - t = t0 - iloop = 0 - iout = istep_out - idump = istep_dump - nloops = ceiling((tstop - t0) / dt, kind=I8B) - ioutput_t0 = int(t0 / dt / istep_out, kind=I8B) - ioutput = ioutput_t0 - ! Prevent duplicate frames from being written if this is a restarted run - if ((param%lrestart) .and. ((param%out_type == REAL8_TYPE) .or. param%out_type == REAL4_TYPE)) then - old_t_final = nbody_system%get_old_t_final_bin(param) - else if ((param%lrestart) .and. ((param%out_type == NETCDF_DOUBLE_TYPE) .or. param%out_type == NETCDF_FLOAT_TYPE)) then - old_t_final = nbody_system%get_old_t_final_netcdf(param) - else - old_t_final = t0 - if (param%lenergy) call nbody_system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum - if (istep_out > 0) call nbody_system%write_frame(param) - end if - - !> Define the maximum number of threads - nthreads = 1 ! In the *serial* case - !$ nthreads = omp_get_max_threads() ! In the *parallel* case - !$ write(*,'(a)') ' OpenMP parameters:' - !$ write(*,'(a)') ' ------------------' - !$ write(*,'(a,i3,/)') ' Number of threads = ', nthreads - write(*, *) " *************** Main Loop *************** " - if (param%lrestart .and. param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) - do iloop = 1, nloops - !> Step the system forward in time - call integration_timer%start() - call nbody_system%step(param, t, dt) - call integration_timer%stop() - - t = t0 + iloop * dt - - !> Evaluate any discards or collisional outcomes - call nbody_system%discard(param) - - !> If the loop counter is at the output cadence value, append the data file with a single frame - if (istep_out > 0) then - iout = iout - 1 - if (iout == 0) then - ioutput = ioutput_t0 + iloop / istep_out - if (t > old_t_final) call nbody_system%write_frame(param) - - tfrac = (param%t - param%t0) / (param%tstop - param%t0) - - select type(pl => nbody_system%pl) - class is (symba_pl) - write(*, symbastatfmt) param%t, tfrac, pl%nplm, pl%nbody, nbody_system%tp%nbody - class default - write(*, statusfmt) param%t, tfrac, pl%nbody, nbody_system%tp%nbody - end select - if (param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) - call integration_timer%report(message="Integration steps:", nsubsteps=istep_out) - call integration_timer%reset() - - iout = istep_out - end if - end if - - !> If the loop counter is at the dump cadence value, dump the state of the system to a file in case it needs to be restarted - if (istep_dump > 0) then - idump = idump - 1 - if (idump == 0) then - call nbody_system%dump(param) - idump = istep_dump - end if - end if - end do - end associate - - call nbody_system%dealloc() - - call util_exit(SUCCESS) - - stop -end program swiftest_driver diff --git a/src/misc/io_progress_bar_module.f90 b/src/misc/io_progress_bar_module.f90 new file mode 100644 index 000000000..470863f31 --- /dev/null +++ b/src/misc/io_progress_bar_module.f90 @@ -0,0 +1,98 @@ +module io_progress_bar + !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Definition of classes and methods used to determine close encounters + use globals + use base + implicit none + public + + character(len=1),parameter, private :: barchar = "#" !! The progress bar character + + type :: progress_bar + !! author: David A. Minton + !! + !! Implements a class for a simple progress bar that can print on the screen. + integer(I4B) :: PBARSIZE = 80 !! Number of characters acros for a whole progress bar + integer(I8B) :: loop_length !! The total number of loops that the progrees bar is executing + character(len=:), allocatable :: barstr !! The string that prints out as the progress bar + integer(I4B) :: bar_pos !! The current position of the progress bar + character(len=32) :: fmt !! The format string that is used to define the progress bar itself + character(len=64) :: message !! The current message displayed at the end of the progress bar + contains + procedure :: reset => io_progress_bar_reset !! Resets the progress bar to the beginning + procedure :: update => io_progress_bar_update !! Updates the progress bar with new values + end type progress_bar + +contains + + subroutine io_progress_bar_reset(self, loop_length) + !! author: David A. Minton + !! + !! Resets the progress bar to the beginning + implicit none + ! Arguments + class(progress_bar),intent(inout) :: self !! The progress bar object + integer(I8B), intent(in) :: loop_length !! The length of the loop that the progress bar is attached to + ! Internals + character(len=2) :: numchar + integer(I4B) :: k + + if (.not.allocated(self%barstr)) then + allocate(character(self%PBARSIZE) :: self%barstr) + end if + do k = 1, self%PBARSIZE + self%barstr(k:k) = " " + end do + write(numchar,'(I2)') self%PBARSIZE + self%fmt = '(A1,"[",A' // numchar // ',"] ",A,$)' + self%loop_length = loop_length + self%bar_pos = 0 + self%message = "" + + write(*,fmt=self%fmt) char(13),self%barstr,trim(adjustl(self%message)) + + return + end subroutine io_progress_bar_reset + + + subroutine io_progress_bar_update(self,i,message) + !! author: David A. Minton + !! + !! Updates the progress bar with new values + implicit none + ! Arguments + class(progress_bar), intent(inout) :: self !! Progres bar object + integer(I8B), intent(in) :: i !! The current loop index of the progress loop + character(len=*), intent(in), optional :: message !! An optional message to display to the right of the progress bar + ! Internals + real(DP) :: frac + integer(I4B) :: bar_pos !! The current integer position of the progress bar + logical :: update = .false. + + ! Compute the current position + frac = real(i,kind=DP) / real(self%loop_length,kind=DP) + bar_pos = min(int(ceiling(frac * self%PBARSIZE),kind=I4B),self%PBARSIZE) + + if (bar_pos /= self%bar_pos) then + ! Fill in the bar character up to the current position + self%barstr(bar_pos:bar_pos) = barchar + update = .true. + self%bar_pos = bar_pos + end if + + if (present(message)) then + if (message /= self%message) then + update = .true. + self%message = message + end if + end if + + if (update) write(*,fmt=self%fmt) char(13),self%barstr,trim(adjustl(self%message)) + + + return + end subroutine io_progress_bar_update + + +end module io_progress_bar diff --git a/src/modules/lambda_function.f90 b/src/misc/lambda_function_module.f90 similarity index 99% rename from src/modules/lambda_function.f90 rename to src/misc/lambda_function_module.f90 index 44b97dfcc..9f7a0ef70 100644 --- a/src/modules/lambda_function.f90 +++ b/src/misc/lambda_function_module.f90 @@ -130,7 +130,7 @@ module lambda_function !! end program usage !! ******************************************************************************************************************************************************************************************** - use swiftest_globals + use globals implicit none public diff --git a/src/misc/solver_module.f90 b/src/misc/solver_module.f90 new file mode 100644 index 000000000..4fbf7b7b3 --- /dev/null +++ b/src/misc/solver_module.f90 @@ -0,0 +1,263 @@ +!! 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. + +module solver + !! author: David A. Minton + !! + !! Contains a 4th order Runge-Kutta-Fehlberg ODE solver and a linear system of equations solver + use globals + use base + use lambda_function + use, intrinsic :: ieee_exceptions + private + public :: solve_linear_system, solve_rkf45 + + interface solve_linear_system + module procedure solve_linear_system_dp + module procedure solve_linear_system_qp + end interface + + interface + module function solve_rkf45(f, y0in, t1, dt0, tol) result(y1) + implicit none + class(lambda_obj), intent(inout) :: f !! lambda function object that has been initialized to be a function of derivatives. The object will return with components lastarg and lasteval set + real(DP), dimension(:), intent(in) :: y0in !! Initial value at t=0 + real(DP), intent(in) :: t1 !! Final time + real(DP), intent(in) :: dt0 !! Initial step size guess + real(DP), intent(in) :: tol !! Tolerance on solution + real(DP), dimension(:), allocatable :: y1 !! Final result + end function solve_rkf45 + end interface + + + contains + + function solve_linear_system_dp(A,b,n,lerr) result(x) + !! Author: David A. Minton + !! + !! Solves the linear equation of the form A*x = b for x. + !! A is an (n,n) arrays + !! x and b are (n) arrays + !! Uses Gaussian elimination, so will have issues if nbody_system is ill-conditioned. + !! Uses quad precision intermidiate values, so works best on small arrays. + implicit none + ! Arguments + integer(I4B), intent(in) :: n + real(DP), dimension(:,:), intent(in) :: A + real(DP), dimension(:), intent(in) :: b + logical, intent(out) :: lerr + ! Result + real(DP), dimension(n) :: x + ! Internals + real(QP), dimension(:), allocatable :: qx + type(ieee_status_type) :: original_fpe_status + logical, dimension(:), allocatable :: fpe_flag + + call ieee_get_status(original_fpe_status) ! Save the original floating point exception status + call ieee_set_flag(ieee_all, .false.) ! Set all flags to quiet + allocate(fpe_flag(size(ieee_usual))) + + qx = solve_wbs(ge_wpp(real(A, kind=QP), real(b, kind=QP))) + + call ieee_get_flag(ieee_usual, fpe_flag) + lerr = any(fpe_flag) + if (lerr .or. (any(abs(qx) > huge(x))) .or. (any(abs(qx) < tiny(x)))) then + x = 0.0_DP + else + x = real(qx, kind=DP) + end if + call ieee_set_status(original_fpe_status) + + return + end function solve_linear_system_dp + + + function solve_linear_system_qp(A,b,n,lerr) result(x) + !! Author: David A. Minton + !! + !! Solves the linear equation of the form A*x = b for x. + !! A is an (n,n) arrays + !! x and b are (n) arrays + !! Uses Gaussian elimination, so will have issues if nbody_system is ill-conditioned. + !! Uses quad precision intermidiate values, so works best on small arrays. + implicit none + ! Arguments + integer(I4B), intent(in) :: n + real(QP), dimension(:,:), intent(in) :: A + real(QP), dimension(:), intent(in) :: b + logical, intent(out) :: lerr + ! Result + real(QP), dimension(n) :: x + ! Internals + type(ieee_status_type) :: original_fpe_status + logical, dimension(:), allocatable :: fpe_flag + + call ieee_get_status(original_fpe_status) ! Save the original floating point exception status + call ieee_set_flag(ieee_all, .false.) ! Set all flags to quiet + allocate(fpe_flag(size(ieee_usual))) + + x = solve_wbs(ge_wpp(A, b)) + + call ieee_get_flag(ieee_usual, fpe_flag) + lerr = any(fpe_flag) + if (lerr) x = 0.0_DP + call ieee_set_status(original_fpe_status) + + return + end function solve_linear_system_qp + + + function solve_wbs(u) result(x) ! solve with backward substitution + !! Based on code available on Rosetta Code: https://rosettacode.org/wiki/Gaussian_elimination#Fortran + implicit none + ! Arguments + real(QP), intent(in), dimension(:,:), allocatable :: u + ! Result + real(QP), dimension(:), allocatable :: x + ! Internals + integer(I4B) :: i,n + + n = size(u, 1) + if (allocated(x)) deallocate(x) + if (.not.allocated(x)) allocate(x(n)) + if (any(abs(u) < tiny(1._DP)) .or. any(abs(u) > huge(1._DP))) then + x(:) = 0._DP + return + end if + call ieee_set_halting_mode(ieee_divide_by_zero, .false.) + do i = n, 1, -1 + x(i) = (u(i, n + 1) - sum(u(i, i + 1:n) * x(i + 1:n))) / u(i, i) + end do + return + end function solve_wbs + + + function ge_wpp(A, b) result(u) ! gaussian eliminate with partial pivoting + !! Solve Ax=b using Gaussian elimination then backwards substitution. + !! A being an n by n matrix. + !! x and b are n by 1 vectors. + !! Based on code available on Rosetta Code: https://rosettacode.org/wiki/Gaussian_elimination#Fortran + implicit none + ! Arguments + real(QP), dimension(:,:), intent(in) :: A + real(QP), dimension(:), intent(in) :: b + ! Result + real(QP), dimension(:,:), allocatable :: u + ! Internals + integer(I4B) :: i,j,n,p + real(QP) :: upi + + n = size(a, 1) + allocate(u(n, (n + 1))) + u = reshape([A, b], [n, n + 1]) + call ieee_set_halting_mode(ieee_divide_by_zero, .false.) + do j = 1, n + p = maxloc(abs(u(j:n, j)), 1) + j - 1 ! maxloc returns indices between (1, n - j + 1) + if (p /= j) u([p, j], j) = u([j, p], j) + u(j + 1:, j) = u(j + 1:, j) / u(j, j) + do i = j + 1, n + 1 + upi = u(p, i) + if (p /= j) u([p, j], i) = u([j, p], i) + u(j + 1:n, i) = u(j + 1:n, i) - upi * u(j + 1:n, j) + end do + end do + return + end function ge_wpp + + + module function solve_rkf45(f, y0in, t1, dt0, tol) result(y1) + !! author: David A. Minton + !! + !! Implements the 4th order Runge-Kutta-Fehlberg ODE solver for initial value problems of the form f=dy/dt, y0 = y(t=0), solving for y1 = y(t=t1). Uses a 5th order adaptive step size control. + !! Uses a lambda function object as defined in the lambda_function module + implicit none + ! Arguments + class(lambda_obj), intent(inout) :: f !! lambda function object that has been initialized to be a function of derivatives. The object will return with components lastarg and lasteval set + real(DP), dimension(:), intent(in) :: y0in !! Initial value at t=0 + real(DP), intent(in) :: t1 !! Final time + real(DP), intent(in) :: dt0 !! Initial step size guess + real(DP), intent(in) :: tol !! Tolerance on solution + ! Result + real(DP), dimension(:), allocatable :: y1 !! Final result + ! Internals + integer(I4B), parameter :: MAXREDUX = 1000 !! Maximum number of times step size can be reduced + real(DP), parameter :: DTFAC = 0.95_DP !! Step size reduction safety factor (Value just under 1.0 to prevent adaptive step size control from discarding steps too aggressively) + integer(I4B), parameter :: RKS = 6 !! Number of RK stages + real(DP), dimension(RKS, RKS - 1), parameter :: rkf45_btab = reshape( & !! Butcher tableau for Runge-Kutta-Fehlberg method + (/ 1./4., 1./4., 0., 0., 0., 0.,& + 3./8., 3./32., 9./32., 0., 0., 0.,& + 12./13., 1932./2197., -7200./2197., 7296./2197., 0., 0.,& + 1., 439./216., -8., 3680./513., -845./4104., 0.,& + 1./2., -8./27., 2., -3544./2565., 1859./4104., -11./40./), shape(rkf45_btab)) + real(DP), dimension(RKS), parameter :: rkf4_coeff = (/ 25./216., 0., 1408./2565. , 2197./4104. , -1./5., 0. /) + real(DP), dimension(RKS), parameter :: rkf5_coeff = (/ 16./135., 0., 6656./12825., 28561./56430., -9./50., 2./55. /) + real(DP), dimension(:, :), allocatable :: k !! Runge-Kutta coefficient vector + real(DP), dimension(:), allocatable :: ynorm !! Normalized y value used for adaptive step size control + real(DP), dimension(:), allocatable :: y0 !! Value of y at the beginning of each substep + integer(I4B) :: Nvar !! Number of variables in problem + integer(I4B) :: rkn !! Runge-Kutta loop index + real(DP) :: t, x1, dt, trem !! Current time, step size and total time remaining + real(DP) :: s, yerr, yscale !! Step size reduction factor, error in dependent variable, and error scale factor + integer(I4B) :: i + + allocate(y0, source=y0in) + allocate(y1, mold=y0) + allocate(ynorm, mold=y0) + Nvar = size(y0) + allocate(k(Nvar, RKS)) + + dt = dt0 + + trem = t1 + t = 0._DP + do + yscale = norm2(y0(:)) + do i = 1, MAXREDUX + select type(f) + class is (lambda_obj_tvar) + do rkn = 1, RKS + y1(:) = y0(:) + matmul(k(:, 1:rkn - 1), rkf45_btab(2:rkn, rkn - 1)) + if (rkn == 1) then + x1 = t + else + x1 = t + rkf45_btab(1,rkn-1) + end if + k(:, rkn) = dt * f%evalt(y1(:), t) + end do + class is (lambda_obj) + do rkn = 1, RKS + y1(:) = y0(:) + matmul(k(:, 1:rkn - 1), rkf45_btab(2:rkn, rkn - 1)) + k(:, rkn) = dt * f%eval(y1(:)) + end do + end select + ! Now determine if the step size needs adjusting + ynorm(:) = matmul(k(:,:), (rkf5_coeff(:) - rkf4_coeff(:))) / yscale + yerr = norm2(ynorm(:)) + s = (tol / (2 * yerr))**(0.25_DP) + dt = min(s * DTFAC * dt, trem) ! Alter step size either up or down, but never bigger than the remaining time + if (s >= 1.0_DP) exit ! Good step! + if (i == MAXREDUX) then + write(*,*) "Something has gone wrong in util_solve_rkf45!! Step size reduction has gone too far this time!" + call util_exit(FAILURE) + end if + end do + + ! Compute new value then step ahead in time + y1(:) = y0(:) + matmul(k(:, :), rkf4_coeff(:)) + trem = trem - dt + t = t + dt + if (trem <= 0._DP) exit + y0(:) = y1(:) + end do + + return + end function solve_rkf45 + + +end module solver \ No newline at end of file diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 deleted file mode 100644 index d7c949a01..000000000 --- a/src/modules/fraggle_classes.f90 +++ /dev/null @@ -1,278 +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. - -module fraggle_classes - !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Definition of classes and methods specific to Fraggel: The Fragment Generation Model - use swiftest_globals - use swiftest_classes, only : swiftest_parameters, swiftest_nbody_system, swiftest_cb, swiftest_pl - implicit none - public - - integer(I4B), parameter :: FRAGGLE_NMASS_DIST = 3 !! Number of mass bins returned by the regime calculation (largest fragment, second largest, and remainder) - character(len=*), parameter :: FRAGGLE_LOG_OUT = "fraggle.log" !! Name of log file for Fraggle diagnostic information - - !******************************************************************************************************************************** - ! fraggle_colliders class definitions and method interfaces - !******************************************************************************************************************************* - !> Class definition for the variables that describe the bodies involved in the collision - type :: fraggle_colliders - integer(I4B) :: ncoll !! Number of bodies involved in the collision - integer(I4B), dimension(:), allocatable :: idx !! Index of bodies involved in the collision - real(DP), dimension(NDIM,2) :: xb !! Two-body equivalent position vectors of the collider bodies prior to collision - real(DP), dimension(NDIM,2) :: vb !! Two-body equivalent velocity vectors of the collider bodies prior to collision - real(DP), dimension(NDIM,2) :: rot !! Two-body equivalent principal axes moments of inertia the collider bodies prior to collision - real(DP), dimension(NDIM,2) :: L_spin !! Two-body equivalent spin angular momentum vectors of the collider bodies prior to collision - real(DP), dimension(NDIM,2) :: L_orbit !! Two-body equivalent orbital angular momentum vectors of the collider bodies prior to collision - real(DP), dimension(NDIM,2) :: Ip !! Two-body equivalent principal axes moments of inertia the collider bodies prior to collision - real(DP), dimension(2) :: mass !! Two-body equivalent mass of the collider bodies prior to the collision - real(DP), dimension(2) :: radius !! Two-body equivalent radii of the collider bodies prior to the collision - contains - procedure :: regime => fraggle_regime_colliders !! Determine which fragmentation regime the set of colliders will be - end type fraggle_colliders - - !******************************************************************************************************************************** - ! fraggle_fragments class definitions and method interfaces - !******************************************************************************************************************************* - !> Class definition for the variables that describe a collection of fragments by Fraggle barycentric coordinates - type, extends(swiftest_pl) :: fraggle_fragments - real(DP) :: mtot !! Total mass of fragments - real(DP) :: Qloss !! Energy lost during the collision - real(DP), dimension(FRAGGLE_NMASS_DIST) :: mass_dist !! Distribution of fragment mass determined by the regime calculation (largest fragment, second largest, and remainder) - integer(I4B) :: regime !! Collresolve regime code for this collision - - ! Values in a coordinate frame centered on the collider barycenter and collisional system unit vectors (these are used internally by the fragment generation subroutine) - real(DP), dimension(NDIM) :: xbcom !! Center of mass position vector of the collider system in system barycentric coordinates - real(DP), dimension(NDIM) :: vbcom !! Velocity vector of the center of mass of the collider system in system barycentric coordinates - real(DP), dimension(NDIM) :: x_coll_unit !! x-direction unit vector of collisional system - real(DP), dimension(NDIM) :: y_coll_unit !! y-direction unit vector of collisional system - real(DP), dimension(NDIM) :: z_coll_unit !! z-direction unit vector of collisional system - real(DP), dimension(:,:), allocatable :: x_coll !! Array of fragment position vectors in the collisional coordinate frame - real(DP), dimension(:,:), allocatable :: v_coll !! Array of fragment velocity vectors in the collisional coordinate frame - real(DP), dimension(:,:), allocatable :: v_r_unit !! Array of radial direction unit vectors of individual fragments in the collisional coordinate frame - real(DP), dimension(:,:), allocatable :: v_t_unit !! Array of tangential direction unit vectors of individual fragments in the collisional coordinate frame - real(DP), dimension(:,:), allocatable :: v_n_unit !! Array of normal direction unit vectors of individual fragments in the collisional coordinate frame - real(DP), dimension(:), allocatable :: rmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame - real(DP), dimension(:), allocatable :: rotmag !! Array of rotation magnitudes of individual fragments - real(DP), dimension(:), allocatable :: v_r_mag !! Array of radial direction velocity magnitudes of individual fragments - real(DP), dimension(:), allocatable :: v_t_mag !! Array of tangential direction velocity magnitudes of individual fragments - - ! Energy and momentum book-keeping variables that characterize the whole system of fragments - real(DP) :: ke_orbit !! Current orbital kinetic energy of the system of fragments in the collisional frame - real(DP) :: ke_spin !! Current spin kinetic energy of the system of fragments in the collisional frame - real(DP), dimension(NDIM) :: L_orbit !! Current orbital angular momentum of the system of fragments in the collisional frame - real(DP), dimension(NDIM) :: L_spin !! Current spin angular momentum of the system of fragments in the collisional frame - real(DP) :: ke_budget !! Total kinetic energy budget for the system of fragmens in the collisional frame - real(DP), dimension(NDIM) :: L_budget !! Total angular momentum budget for the system of fragmens in the collisional frame - - ! For the following variables, "before" refers to the *entire* n-body system in its pre-collisional state and "after" refers to the system in its post-collisional state - real(DP), dimension(NDIM) :: Lorbit_before, Lorbit_after !! Before/after orbital angular momentum - real(DP), dimension(NDIM) :: Lspin_before, Lspin_after !! Before/after spin angular momentum - real(DP), dimension(NDIM) :: Ltot_before, Ltot_after !! Before/after total system angular momentum - real(DP) :: ke_orbit_before, ke_orbit_after !! Before/after orbital kinetic energy - real(DP) :: ke_spin_before, ke_spin_after !! Before/after spin kinetic energy - real(DP) :: pe_before, pe_after !! Before/after potential energy - real(DP) :: Etot_before, Etot_after !! Before/after total system energy - - ! Scale factors used to scale dimensioned quantities to a more "natural" system where important quantities (like kinetic energy, momentum) are of order ~1 - real(DP) :: dscale !! Distance dimension scale factor - real(DP) :: mscale !! Mass scale factor - real(DP) :: tscale !! Time scale factor - real(DP) :: vscale !! Velocity scale factor (a convenience unit that is derived from dscale and tscale) - real(DP) :: Escale !! Energy scale factor (a convenience unit that is derived from dscale, tscale, and mscale) - real(DP) :: Lscale !! Angular momentum scale factor (a convenience unit that is derived from dscale, tscale, and mscale) - contains - procedure :: generate_fragments => fraggle_generate_fragments !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. - procedure :: accel => fraggle_placeholder_accel !! Placeholder subroutine to fulfill requirement for an accel method - procedure :: kick => fraggle_placeholder_kick !! Placeholder subroutine to fulfill requirement for a kick method - procedure :: step => fraggle_placeholder_step !! Placeholder subroutine to fulfill requirement for a step method - procedure :: set_budgets => fraggle_set_budgets_fragments !! Sets the energy and momentum budgets of the fragments based on the collider value - procedure :: set_coordinate_system => fraggle_set_coordinate_system !! Defines the collisional coordinate system, including the unit vectors of both the system and individual fragments. - procedure :: set_mass_dist => fraggle_set_mass_dist_fragments !! Sets the distribution of mass among the fragments depending on the regime type - procedure :: set_natural_scale => fraggle_set_natural_scale_factors !! Scales dimenional quantities to ~O(1) with respect to the collisional system. - procedure :: set_original_scale => fraggle_set_original_scale_factors !! Restores dimenional quantities back to the original system units - procedure :: setup => fraggle_setup_fragments !! Allocates arrays for n fragments in a Fraggle system. Passing n = 0 deallocates all arrays. - procedure :: reset => fraggle_setup_reset_fragments !! 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) - procedure :: get_ang_mtm => fraggle_util_ang_mtm !! Calcualtes the current angular momentum of the fragments - procedure :: get_energy_and_momentum => fraggle_util_get_energy_momentum !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) - procedure :: restructure => fraggle_util_restructure !! Restructure the inputs after a failed attempt failed to find a set of positions and velocities that satisfy the energy and momentum constraints - end type fraggle_fragments - - interface - module subroutine fraggle_generate_fragments(self, colliders, system, param, lfailure) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters - implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object containing the two-body equivalent values of the colliding bodies - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? - end subroutine fraggle_generate_fragments - - module subroutine fraggle_io_log_generate(frag) - implicit none - class(fraggle_fragments), intent(in) :: frag - end subroutine fraggle_io_log_generate - - module subroutine fraggle_io_log_pl(pl, param) - implicit none - class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object (only the new bodies generated in a collision) - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters - end subroutine fraggle_io_log_pl - - module subroutine fraggle_io_log_regime(colliders, frag) - implicit none - class(fraggle_colliders), intent(in) :: colliders - class(fraggle_fragments), intent(in) :: frag - end subroutine fraggle_io_log_regime - - !> The following interfaces are placeholders intended to satisfy the required abstract methods given by the parent class - module subroutine fraggle_placeholder_accel(self, system, param, t, lbeg) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters - implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(swiftest_nbody_system), intent(inout) :: 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 fraggle_placeholder_accel - - module subroutine fraggle_placeholder_kick(self, system, param, t, dt, lbeg) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters - implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(swiftest_nbody_system), intent(inout) :: 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 fraggle_placeholder_kick - - module subroutine fraggle_placeholder_step(self, system, param, t, dt) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters - implicit none - class(fraggle_fragments), intent(inout) :: self !! Helio massive body particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current simulation time - real(DP), intent(in) :: dt !! Stepsiz - end subroutine fraggle_placeholder_step - - module subroutine fraggle_regime_colliders(self, frag, system, param) - implicit none - class(fraggle_colliders), intent(inout) :: self !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragment system object - class(swiftest_nbody_system), intent(in) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters - end subroutine fraggle_regime_colliders - - module subroutine fraggle_set_budgets_fragments(self) - implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - end subroutine fraggle_set_budgets_fragments - - module subroutine fraggle_set_coordinate_system(self, colliders) - implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object - end subroutine fraggle_set_coordinate_system - - module subroutine fraggle_set_mass_dist_fragments(self, colliders, param) - implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object - class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters - end subroutine fraggle_set_mass_dist_fragments - - module subroutine fraggle_set_natural_scale_factors(self, colliders) - implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object - end subroutine fraggle_set_natural_scale_factors - - module subroutine fraggle_set_original_scale_factors(self, colliders) - implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object - end subroutine fraggle_set_original_scale_factors - - module subroutine fraggle_setup_fragments(self, n, param) - implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - integer(I4B), intent(in) :: n !! Number of fragments - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters - end subroutine fraggle_setup_fragments - - module subroutine fraggle_setup_reset_fragments(self) - implicit none - class(fraggle_fragments), intent(inout) :: self - end subroutine fraggle_setup_reset_fragments - - module subroutine fraggle_util_add_fragments_to_system(frag, colliders, system, param) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters - implicit none - class(fraggle_fragments), intent(in) :: frag !! Fraggle fragment system object - class(fraggle_colliders), intent(in) :: colliders !! Fraggle collider system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters - end subroutine fraggle_util_add_fragments_to_system - - module subroutine fraggle_util_ang_mtm(self) - implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - end subroutine fraggle_util_ang_mtm - - module subroutine fraggle_util_construct_temporary_system(frag, system, param, tmpsys, tmpparam) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters - implicit none - class(fraggle_fragments), intent(in) :: frag !! Fraggle fragment system object - class(swiftest_nbody_system), intent(in) :: system !! Original swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters - class(swiftest_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object - class(swiftest_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters - end subroutine fraggle_util_construct_temporary_system - - module subroutine fraggle_util_get_energy_momentum(self, colliders, system, param, lbefore) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters - implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the system, with colliders included and fragments excluded or vice versa - end subroutine fraggle_util_get_energy_momentum - - module subroutine fraggle_util_restructure(self, colliders, try, f_spin, r_max_start) - implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(in) :: colliders !! Fraggle collider system object - integer(I4B), intent(in) :: try !! The current number of times Fraggle has tried to find a solution - real(DP), intent(inout) :: f_spin !! Fraction of energy/momentum that goes into spin. This decreases ater a failed attempt - real(DP), intent(inout) :: r_max_start !! The maximum radial distance that the position calculation starts with. This increases after a failed attempt - end subroutine fraggle_util_restructure - - module subroutine fraggle_util_shift_vector_to_origin(m_frag, vec_frag) - implicit none - real(DP), dimension(:), intent(in) :: m_frag !! Fragment masses - real(DP), dimension(:,:), intent(inout) :: vec_frag !! Fragment positions or velocities in the center of mass frame - end subroutine - - module function fraggle_util_vmag_to_vb(v_r_mag, v_r_unit, v_t_mag, v_t_unit, m_frag, vcom) result(vb) - implicit none - real(DP), dimension(:), intent(in) :: v_r_mag !! Unknown radial component of fragment velocity vector - real(DP), dimension(:), intent(in) :: v_t_mag !! Tangential component of velocity vector set previously by angular momentum constraint - real(DP), dimension(:,:), intent(in) :: v_r_unit, v_t_unit !! Radial and tangential unit vectors for each fragment - real(DP), dimension(:), intent(in) :: m_frag !! Fragment masses - real(DP), dimension(:), intent(in) :: vcom !! Barycentric velocity of collisional system center of mass - real(DP), dimension(:,:), allocatable :: vb - end function fraggle_util_vmag_to_vb - end interface - -end module fraggle_classes \ No newline at end of file diff --git a/src/modules/swiftest.f90 b/src/modules/swiftest.f90 deleted file mode 100644 index 6f84c66b9..000000000 --- a/src/modules/swiftest.f90 +++ /dev/null @@ -1,31 +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. - -module swiftest - !! author: David A. Minton - !! graph: false - !! - !! 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. - use swiftest_globals - use swiftest_operators - use swiftest_classes - use whm_classes - use rmvs_classes - use helio_classes - use symba_classes - use fraggle_classes - use lambda_function - use walltime_classes - use encounter_classes - !use advisor_annotate - !$ use omp_lib - implicit none - public - -end module swiftest diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 deleted file mode 100644 index 6c0ac2be3..000000000 --- a/src/modules/swiftest_classes.f90 +++ /dev/null @@ -1,1851 +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. - -module swiftest_classes - !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Definition of data and structures generic to all integrators. - !! Adapted from David E. Kaufmann's Swifter routine: module_swifter.f90 - use swiftest_globals - implicit none - public - - type, extends(netcdf_variables) :: netcdf_parameters - contains - procedure :: close => netcdf_close !! Closes an open NetCDF file - procedure :: flush => netcdf_flush !! Flushes the current buffer to disk by closing and re-opening the file. - procedure :: initialize => netcdf_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object - procedure :: open => netcdf_open !! Opens a NetCDF file - procedure :: sync => netcdf_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 - - !******************************************************************************************************************************** - ! swiftest_parameters class definitions - !******************************************************************************************************************************** - - !> User defined parameters that are read in from the parameters input file. - !> Each paramter is initialized to a default values. - type :: swiftest_parameters - integer(I4B) :: integrator = UNKNOWN_INTEGRATOR !! Symbolic name of the nbody integrator used - character(STRMAX) :: param_file_name = "param.in" !! The default name of the parameter input file - integer(I4B) :: maxid = -1 !! The current maximum particle id number - integer(I4B) :: maxid_collision = 0 !! The current maximum collision id number - real(DP) :: t0 = -1.0_DP !! Integration start time - real(DP) :: t = -1.0_DP !! Integration current time - real(DP) :: tstop = -1.0_DP !! Integration stop time - real(DP) :: dt = -1.0_DP !! Time step - integer(I8B) :: ioutput = 0_I8B !! Output counter - 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) :: in_netcdf = NC_INFILE !! Name of system input file for NetCDF input - character(STRMAX) :: in_type = ASCII_TYPE !! 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 binary outputs - character(STRMAX) :: outfile = NETCDF_OUTFILE !! Name of output binary file - character(STRMAX) :: out_type = NETCDF_DOUBLE_TYPE !! 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 - character(STRMAX) :: particle_out = PARTICLE_OUTFILE !! Name of output particle information file - integer(I4B) :: istep_dump = -1 !! Number of time steps between dumps - 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 - real(DP) :: qmin_alo = -1.0_DP !! Minimum semimajor axis for qmin - real(DP) :: qmin_ahi = -1.0_DP !! Maximum semimajor axis for qmin - character(STRMAX) :: enc_out = "" !! Name of output file for encounters - character(STRMAX) :: discard_out = "" !! Name of output file for discards - 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 - character(STRMAX) :: energy_out = "" !! Name of output energy and momentum report file - 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" - ! The following are used internally, and 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 :: ladaptive_interactions = .false. !! Adaptive interaction loop is turned on (choose between TRIANGULAR and FLAT based on periodic timing tests) - 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 :: ladaptive_encounters_plpl = .false. !! Adaptive encounter checking is turned on (choose between TRIANGULAR or SORTSWEEP based on periodic timing tests) - logical :: ladaptive_encounters_pltp = .false. !! Adaptive encounter checking is turned on (choose between TRIANGULAR or SORTSWEEP based on periodic timing tests) - - ! 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 - - ! 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) :: Eorbit_orig = 0.0_DP !! Initial orbital energy - real(DP) :: GMtot_orig = 0.0_DP !! Initial system mass - real(DP), dimension(NDIM) :: Ltot_orig = 0.0_DP !! Initial total angular momentum vector - real(DP), dimension(NDIM) :: Lorbit_orig = 0.0_DP !! Initial orbital angular momentum - real(DP), dimension(NDIM) :: Lspin_orig = 0.0_DP !! Initial spin angular momentum vector - real(DP), dimension(NDIM) :: Lescape = 0.0_DP !! Angular momentum of bodies that escaped the system (used for bookeeping) - real(DP) :: GMescape = 0.0_DP !! Mass of bodies that escaped the system (used for bookeeping) - real(DP) :: Ecollisions = 0.0_DP !! Energy lost from system due to collisions - real(DP) :: Euntracked = 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 - - ! 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 - - type(netcdf_parameters) :: nciu !! Object containing NetCDF parameters - contains - procedure :: reader => io_param_reader - procedure :: writer => io_param_writer - procedure :: dump => io_dump_param - procedure :: read_in => io_read_in_param - end type swiftest_parameters - - - !******************************************************************************************************************************** - ! swiftest_swiftest_particle_info class definitions and method interfaces - !******************************************************************************************************************************* - !> Class definition for the particle origin information object. This object is used to track time, location, and collisional regime - !> of fragments produced in collisional events. - type :: 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_xh !! 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_xh !! 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 :: dump => io_dump_particle_info !! Dumps contents of particle information to file - procedure :: read_in => io_read_in_particle_info !! Read in a particle information object from an open file - procedure :: copy => util_copy_particle_info !! Copies one set of information object components into another, component-by-component - procedure :: set_value => util_set_particle_info !! Sets one or more values of the particle information metadata object - end type swiftest_particle_info - - !******************************************************************************************************************************** - ! swiftest_base class definitions and methods - !******************************************************************************************************************************** - type, abstract :: swiftest_base - !! An abstract superclass for a generic Swiftest object - contains - !! The minimal methods that all systems must have - procedure :: dump => io_dump_base !! Dump contents to file - procedure :: dump_particle_info => io_dump_particle_info_base !! Dump contents of particle information metadata to file - procedure :: read_in => io_read_in_base !! Read in body initial conditions from a file - procedure :: write_frame_netcdf => netcdf_write_frame_base !! I/O routine for writing out a single frame of time-series data for all bodies in the system in NetCDF format - procedure :: write_particle_info_netcdf => netcdf_write_particle_info_base !! Writes out the particle information metadata to NetCDF file - generic :: write_frame => write_frame_netcdf !! Set up generic procedure that will switch between NetCDF or Fortran binary depending on arguments - generic :: write_particle_info => write_particle_info_netcdf - end type swiftest_base - - !******************************************************************************************************************************** - ! swiftest_cb class definitions and methods - !******************************************************************************************************************************** - !> A concrete lass for the central body in a Swiftest simulation - type, abstract, extends(swiftest_base) :: swiftest_cb - type(swiftest_particle_info) :: 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) :: xb = 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 - contains - procedure :: read_frame_bin => io_read_frame_cb !! I/O routine for reading out a single frame of time-series data for the central body - procedure :: write_frame_bin => io_write_frame_cb !! I/O routine for writing out a single frame of time-series data for the central body - generic :: write_frame => write_frame_bin !! Write a frame (either binary or NetCDF, using generic procedures) - generic :: read_frame => read_frame_bin !! Write a frame (either binary or NetCDF, using generic procedures) - end type swiftest_cb - - !******************************************************************************************************************************** - ! swiftest_body definitions and methods - !******************************************************************************************************************************** - !> An abstract class for a generic collection of Swiftest bodies - type, abstract, extends(swiftest_base) :: 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 - type(swiftest_particle_info), dimension(:), allocatable :: info !! Particle metadata information - integer(I4B), dimension(:), allocatable :: id !! External identifier (unique) - integer(I4B), dimension(:), allocatable :: status !! An integrator-specific status indicator - logical, dimension(:), allocatable :: ldiscard !! Body should be discarded - logical, dimension(:), allocatable :: lmask !! Logical mask used to select a subset of bodies when performing certain operations (drift, kick, accel, etc.) - real(DP), dimension(:), allocatable :: mu !! G * (Mcb + [m]) - real(DP), dimension(:,:), allocatable :: xh !! Swiftestcentric position - real(DP), dimension(:,:), allocatable :: vh !! Swiftestcentric velocity - real(DP), dimension(:,:), allocatable :: xb !! 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 :: atide !! Tanngential component of acceleration of bodies due to tides - real(DP), dimension(:,:), allocatable :: agr !! Acceleration due to post-Newtonian correction - real(DP), dimension(:), allocatable :: ir3h !! Inverse heliocentric radius term (1/rh**3) - 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 - procedure(abstract_set_mu), deferred :: set_mu - procedure(abstract_step_body), deferred :: step - procedure(abstract_accel), deferred :: accel - ! These are concrete because the implementation is the same for all types of particles - procedure :: drift => drift_body !! Loop through bodies and call Danby drift routine on heliocentric variables - procedure :: v2pv => gr_vh2pv_body !! Converts from velocity to psudeovelocity for GR calculations using symplectic integrators - procedure :: pv2v => gr_pv2vh_body !! Converts from psudeovelocity to velocity for GR calculations using symplectic integrators - procedure :: read_frame_bin => io_read_frame_body !! I/O routine for writing out a single frame of time-series data for the central body - procedure :: write_frame_bin => io_write_frame_body !! I/O routine for writing out a single frame of time-series data for the central body - procedure :: accel_obl => obl_acc_body !! Compute the barycentric accelerations of bodies due to the oblateness of the central body - procedure :: el2xv => orbel_el2xv_vec !! Convert orbital elements to position and velocity vectors - procedure :: xv2el => orbel_xv2el_vec !! Convert position and velocity vectors to orbital elements - procedure :: setup => setup_body !! A constructor that sets the number of bodies and allocates all allocatable arrays - procedure :: accel_user => user_kick_getacch_body !! Add user-supplied heliocentric accelerations to planets - procedure :: append => util_append_body !! Appends elements from one structure to another - procedure :: dealloc => util_dealloc_body !! Deallocates all allocatable arrays - procedure :: fill => util_fill_body !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) - procedure :: resize => 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 => util_set_ir3h !! Sets the inverse heliocentric radius term (1/rh**3) - procedure :: sort => util_sort_body !! Sorts body arrays by a sortable componen - procedure :: rearrange => util_sort_rearrange_body !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods - procedure :: spill => util_spill_body !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - generic :: write_frame => write_frame_bin !! Add the generic write frame for Fortran binary files - generic :: read_frame => read_frame_bin !! Add the generic read frame for Fortran binary files - end type swiftest_body - - !******************************************************************************************************************************** - ! swiftest_pl definitions and methods - !******************************************************************************************************************************** - !> An abstract class for a generic collection of Swiftest massive bodies - 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 :: xbeg !! Position at beginning of step - real(DP), dimension(:,:), allocatable :: xend !! Position at end of step - real(DP), dimension(:,:), allocatable :: vbeg !! Velocity at beginning of step - real(DP), dimension(:), allocatable :: density !! Body mass density - calculated internally (units MU / DU**3) - 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 - !! 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 :: discard => discard_pl !! Placeholder method for discarding massive bodies - procedure :: flatten => util_flatten_eucl_plpl !! Sets up the (i, j) -> k indexing used for the single-loop blocking Euclidean distance matrix - procedure :: accel_int => kick_getacch_int_pl !! Compute direct cross (third) term heliocentric accelerations of massive bodies - procedure :: accel_obl => obl_acc_pl !! Compute the barycentric accelerations of bodies due to the oblateness of the central body - procedure :: setup => 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 => util_append_pl !! Appends elements from one structure to another - procedure :: h2b => util_coord_h2b_pl !! Convert massive bodies from heliocentric to barycentric coordinates (position and velocity) - procedure :: b2h => util_coord_b2h_pl !! Convert massive bodies from barycentric to heliocentric coordinates (position and velocity) - procedure :: vh2vb => util_coord_vh2vb_pl !! Convert massive bodies from heliocentric to barycentric coordinates (velocity only) - procedure :: vb2vh => util_coord_vb2vh_pl !! Convert massive bodies from barycentric to heliocentric coordinates (velocity only) - procedure :: xh2xb => util_coord_xh2xb_pl !! Convert massive bodies from heliocentric to barycentric coordinates (position only) - procedure :: dealloc => util_dealloc_pl !! Deallocates all allocatable arrays - procedure :: fill => util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) - procedure :: resize => util_resize_pl !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. - procedure :: set_beg_end => util_set_beg_end_pl !! Sets the beginning and ending positions and velocities of planets. - procedure :: set_mu => util_set_mu_pl !! Method used to construct the vectorized form of the central body mass - procedure :: set_rhill => util_set_rhill !! Calculates the Hill's radii for each body - procedure :: set_renc_I4B => util_set_renc_I4B !! Sets the critical radius for encounter given an inpput integer scale factor - procedure :: set_renc_DP => util_set_renc_DP !! Sets the critical radius for encounter given an input real scale factor - generic :: set_renc => set_renc_I4B, set_renc_DP - procedure :: sort => util_sort_pl !! Sorts body arrays by a sortable component - procedure :: rearrange => util_sort_rearrange_pl !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods - procedure :: spill => util_spill_pl !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - end type swiftest_pl - - !******************************************************************************************************************************** - ! swiftest_tp definitions and methods - !******************************************************************************************************************************** - !> An abstract class for a generic collection of Swiftest test particles - type, abstract, extends(swiftest_body) :: swiftest_tp - !! Superclass that defines the generic elements of a Swiftest test particle - 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 - 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 - !! 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_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 => discard_tp !! Check to see if test particles should be discarded based on their positions relative to the massive bodies - procedure :: accel_int => kick_getacch_int_tp !! Compute direct cross (third) term heliocentric accelerations of test particles by massive bodies - procedure :: accel_obl => obl_acc_tp !! Compute the barycentric accelerations of bodies due to the oblateness of the central body - procedure :: setup => setup_tp !! A base constructor that sets the number of bodies and - procedure :: append => util_append_tp !! Appends elements from one structure to another - procedure :: h2b => util_coord_h2b_tp !! Convert test particles from heliocentric to barycentric coordinates (position and velocity) - procedure :: b2h => util_coord_b2h_tp !! Convert test particles from barycentric to heliocentric coordinates (position and velocity) - procedure :: vb2vh => util_coord_vb2vh_tp !! Convert test particles from barycentric to heliocentric coordinates (velocity only) - procedure :: vh2vb => util_coord_vh2vb_tp !! Convert test particles from heliocentric to barycentric coordinates (velocity only) - procedure :: xh2xb => util_coord_xh2xb_tp !! Convert test particles from heliocentric to barycentric coordinates (position only) - procedure :: dealloc => util_dealloc_tp !! Deallocates all allocatable arrays - procedure :: fill => util_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) - procedure :: get_peri => util_peri_tp !! Determine system pericenter passages for test particles - procedure :: resize => 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 => util_set_mu_tp !! Method used to construct the vectorized form of the central body mass - procedure :: sort => util_sort_tp !! Sorts body arrays by a sortable component - procedure :: rearrange => util_sort_rearrange_tp !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods - procedure :: spill => util_spill_tp !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - end type swiftest_tp - - !******************************************************************************************************************************** - ! swiftest_nbody_system class definitions and methods - !******************************************************************************************************************************** - !> An abstract class for a basic Swiftest nbody system - type, abstract :: swiftest_nbody_system - !! This superclass contains a minimial 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 - real(DP) :: GMtot = 0.0_DP !! Total system mass - used for barycentric coordinate conversion - real(DP) :: ke_orbit = 0.0_DP !! System orbital kinetic energy - real(DP) :: ke_spin = 0.0_DP !! System spin kinetic energy - real(DP) :: pe = 0.0_DP !! System potential energy - real(DP) :: te = 0.0_DP !! System total energy - real(DP) :: oblpot = 0.0_DP !! System potential energy due to oblateness of the central body - real(DP), dimension(NDIM) :: Lorbit = 0.0_DP !! System orbital angular momentum vector - real(DP), dimension(NDIM) :: Lspin = 0.0_DP !! System spin angular momentum vector - real(DP), dimension(NDIM) :: Ltot = 0.0_DP !! System angular momentum vector - real(DP) :: Eorbit_orig = 0.0_DP !! Initial orbital energy - real(DP) :: GMtot_orig = 0.0_DP !! Initial system mass - real(DP), dimension(NDIM) :: Ltot_orig = 0.0_DP !! Initial total angular momentum vector - real(DP), dimension(NDIM) :: Lorbit_orig = 0.0_DP !! Initial orbital angular momentum - real(DP), dimension(NDIM) :: Lspin_orig = 0.0_DP !! Initial spin angular momentum vector - real(DP), dimension(NDIM) :: Lescape = 0.0_DP !! Angular momentum of bodies that escaped the system (used for bookeeping) - real(DP) :: GMescape = 0.0_DP !! Mass of bodies that escaped the system (used for bookeeping) - real(DP) :: Ecollisions = 0.0_DP !! Energy lost from system due to collisions - real(DP) :: Euntracked = 0.0_DP !! Energy gained from system due to escaped bodies - 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 - 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 => discard_system !! Perform a discard step on the system - procedure :: conservation_report => io_conservation_report !! Compute energy and momentum and print out the change with time - procedure :: dump => io_dump_system !! Dump the state of the system to a file - procedure :: get_old_t_final_bin => io_get_old_t_final_system !! Validates the dump file to check whether the dump file initial conditions duplicate the last frame of the binary output. - procedure :: get_old_t_final_netcdf => netcdf_get_old_t_final_system !! Validates the dump file to check whether the dump file initial conditions duplicate the last frame of the netcdf output. - procedure :: read_frame_bin => io_read_frame_system !! Read in a frame of input data from file - procedure :: write_frame_bin => io_write_frame_system !! Append a frame of output data to file - procedure :: read_frame_netcdf => netcdf_read_frame_system !! Read in a frame of input data from file - procedure :: write_frame_netcdf => netcdf_write_frame_system !! Write a frame of input data from file - procedure :: write_hdr_bin => io_write_hdr_system !! Write a header for an output frame in Fortran binary format - procedure :: read_hdr_netcdf => netcdf_read_hdr_system !! Read a header for an output frame in NetCDF format - procedure :: write_hdr_netcdf => netcdf_write_hdr_system !! Write a header for an output frame in NetCDF format - procedure :: read_in => io_read_in_system !! Reads the initial conditions for an nbody system - procedure :: read_particle_info_bin => io_read_particle_info_system !! Read in particle metadata from file - procedure :: read_particle_info_netcdf => netcdf_read_particle_info_system !! Read in particle metadata from file - procedure :: write_discard => io_write_discard !! Write out information about discarded test particles - procedure :: obl_pot => obl_pot_system !! Compute the contribution to the total gravitational potential due solely to the oblateness of the central body - procedure :: finalize => setup_finalize_system !! Runs any finalization subroutines when ending the simulation. - procedure :: initialize => setup_initialize_system !! Initialize the system from input files - procedure :: init_particle_info => setup_initialize_particle_info_system !! Initialize the system from input files - ! procedure :: step_spin => tides_step_spin_system !! Steps the spins of the massive & central bodies due to tides. - procedure :: dealloc => util_dealloc_system !! Deallocates all allocatable components of the system - procedure :: set_msys => util_set_msys !! Sets the value of msys from the masses of system bodies. - procedure :: get_energy_and_momentum => util_get_energy_momentum_system !! Calculates the total system energy and momentum - procedure :: rescale => util_rescale_system !! Rescales the system into a new set of units - procedure :: validate_ids => util_valid_id_system !! Validate the numerical ids passed to the system and save the maximum value - generic :: write_hdr => write_hdr_bin, write_hdr_netcdf !! Generic method call for writing headers - generic :: read_hdr => read_hdr_netcdf !! Generic method call for reading headers - generic :: read_frame => read_frame_bin, read_frame_netcdf !! Generic method call for reading a frame of output data - generic :: write_frame => write_frame_bin, write_frame_netcdf !! Generic method call for writing a frame of output data - generic :: read_particle_info => read_particle_info_bin, read_particle_info_netcdf !! Genereric method call for reading in the particle information metadata - end type swiftest_nbody_system - - abstract interface - - subroutine abstract_accel(self, 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) :: 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, 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) :: 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, 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) :: 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 - - function abstract_read_frame(self, iu, param) result(ierr) - import DP, I4B, swiftest_base, swiftest_parameters - class(swiftest_base), intent(inout) :: self !! Swiftest base 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 abstract_read_frame - - 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 - end subroutine abstract_set_mu - - subroutine abstract_step_body(self, 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) :: system !! Swiftest 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 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 discard_pl(self, system, param) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameter - end subroutine discard_pl - - module subroutine discard_system(self, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine discard_system - - module subroutine discard_tp(self, system, param) - implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine discard_tp - - module subroutine 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 - end subroutine drift_all - - module subroutine drift_body(self, system, param, dt) - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: dt !! Stepsize - end subroutine drift_body - - pure elemental module subroutine drift_one(mu, px, py, pz, vx, vy, vz, dt, iflag) - !$omp declare simd(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) :: px, py, pz, 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 drift_one - - pure module subroutine gr_kick_getaccb_ns_body(self, system, param) - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest generic body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine gr_kick_getaccb_ns_body - - pure module subroutine 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 - end subroutine gr_kick_getacch - - pure module subroutine gr_p4_pos_kick(param, x, v, dt) - implicit none - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), dimension(:), intent(inout) :: x !! Position vector - real(DP), dimension(:), intent(in) :: v !! Velocity vector - real(DP), intent(in) :: dt !! Step size - end subroutine gr_p4_pos_kick - - pure module subroutine gr_pseudovel2vel(param, mu, xh, 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) :: xh !! 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 gr_pseudovel2vel - - pure module subroutine 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 - end subroutine gr_pv2vh_body - - pure module subroutine gr_vel2pseudovel(param, mu, xh, 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) :: xh !! 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 gr_vel2pseudovel - - pure module subroutine 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 - end subroutine gr_vh2pv_body - - module subroutine 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 - end subroutine io_conservation_report - - module subroutine 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) - end subroutine io_dump_param - - module subroutine io_dump_particle_info_base(self, param, idx) - implicit none - class(swiftest_base), intent(inout) :: self !! Swiftest base object (can be cb, pl, or tp) - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I4B), dimension(:), optional, intent(in) :: idx !! Array of test particle indices to append to the particle file - end subroutine io_dump_particle_info_base - - module subroutine io_dump_particle_info(self, iu) - implicit none - class(swiftest_particle_info), intent(in) :: self !! Swiftest particle info metadata object - integer(I4B), intent(in) :: iu !! Open unformatted file unit number - end subroutine io_dump_particle_info - - module subroutine io_dump_base(self, param) - implicit none - class(swiftest_base), intent(inout) :: self !! Swiftest base object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine io_dump_base - - module subroutine io_dump_system(self, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine io_dump_system - - module function io_get_args(integrator, param_file_name) result(ierr) - implicit none - integer(I4B) :: integrator !! Symbolic code of the requested integrator - character(len=:), allocatable :: param_file_name !! Name of the input parameters file - integer(I4B) :: ierr !! I/O error code - end function io_get_args - - module function io_get_old_t_final_system(self, param) result(old_t_final) - implicit none - class(swiftest_nbody_system), intent(in) :: self - class(swiftest_parameters), intent(in) :: param - real(DP) :: old_t_final - end function io_get_old_t_final_system - - module function 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 - end function io_get_token - - module subroutine io_log_one_message(file, message) - implicit none - character(len=*), intent(in) :: file !! Name of file to log - character(len=*), intent(in) :: message - end subroutine io_log_one_message - - module subroutine 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 - end subroutine io_log_start - - module subroutine 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. - integer(I4B), 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 io_param_reader - - module subroutine 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 - end subroutine io_param_writer - end interface - - interface io_param_writer_one - module subroutine 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 - end subroutine io_param_writer_one_char - - module subroutine 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 - end subroutine io_param_writer_one_DP - - module subroutine 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 - end subroutine io_param_writer_one_DParr - - module subroutine 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 - end subroutine io_param_writer_one_I4B - - module subroutine 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 - end subroutine io_param_writer_one_I4Barr - - module subroutine 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 - end subroutine io_param_writer_one_I8B - - module subroutine 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 - end subroutine io_param_writer_one_logical - - module subroutine 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 - end subroutine io_param_writer_one_QP - end interface io_param_writer_one - - interface - - module subroutine io_read_in_base(self,param) - implicit none - class(swiftest_base), intent(inout) :: self !! Swiftest base object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine io_read_in_base - - module subroutine 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) - end subroutine io_read_in_param - - module subroutine io_read_in_particle_info(self, iu) - implicit none - class(swiftest_particle_info), intent(inout) :: self !! Particle metadata information object - integer(I4B), intent(in) :: iu !! Open file unit number - end subroutine io_read_in_particle_info - - module subroutine io_read_in_system(self, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self - class(swiftest_parameters), intent(inout) :: param - end subroutine io_read_in_system - - module function 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 - end function io_read_frame_body - - module function io_read_frame_cb(self, iu, param) result(ierr) - implicit none - class(swiftest_cb), intent(inout) :: self !! Swiftest central 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 io_read_frame_cb - - module function io_read_frame_system(self, iu, param) result(ierr) - implicit none - class(swiftest_nbody_system),intent(inout) :: self !! Swiftest system 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 io_read_frame_system - - module subroutine io_read_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 - end subroutine io_read_particle_info_system - - module subroutine io_write_discard(self, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine io_write_discard - - module subroutine io_toupper(string) - implicit none - character(*), intent(inout) :: string !! String to make upper case - end subroutine io_toupper - - module subroutine io_write_frame_body(self, iu, param) - implicit none - class(swiftest_body), intent(in) :: self !! Swiftest body object - integer(I4B), intent(inout) :: iu !! Unit number for the output file to write frame to - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine io_write_frame_body - - module subroutine io_write_frame_cb(self, iu, param) - implicit none - class(swiftest_cb), intent(in) :: self !! Swiftest central body object - integer(I4B), intent(inout) :: iu !! Unit number for the output file to write frame to - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine io_write_frame_cb - - module subroutine io_write_frame_system(self, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine io_write_frame_system - - module subroutine io_write_hdr_system(self, iu, param) - implicit none - class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object - integer(I4B), intent(inout) :: iu !! Output file unit number - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine io_write_hdr_system - - module subroutine 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 - end subroutine kick_getacch_int_pl - - module subroutine kick_getacch_int_tp(self, param, GMpl, xhp, 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) :: xhp !! Massive body position vectors - integer(I4B), intent(in) :: npl !! Number of active massive bodies - end subroutine kick_getacch_int_tp - - module subroutine kick_getacch_int_all_flat_pl(npl, nplpl, k_plpl, x, 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) :: x !! Position vector array - real(DP), dimension(:), intent(in) :: Gmass !! Array of massive body G*mass - real(DP), dimension(:), intent(in), optional :: radius !! Array of massive body radii - real(DP), dimension(:,:), intent(inout) :: acc !! Acceleration vector array - end subroutine kick_getacch_int_all_flat_pl - - module subroutine kick_getacch_int_all_triangular_pl(npl, nplm, x, 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) :: x !! Position vector array - real(DP), dimension(:), intent(in) :: Gmass !! Array of massive body G*mass - real(DP), dimension(:), intent(in), optional :: radius !! Array of massive body radii - real(DP), dimension(:,:), intent(inout) :: acc !! Acceleration vector array - end subroutine kick_getacch_int_all_triangular_pl - - module subroutine kick_getacch_int_all_tp(ntp, npl, xtp, xpl, 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) :: xtp !! Test particle position vector array - real(DP), dimension(:,:), intent(in) :: xpl !! 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 kick_getacch_int_all_tp - - pure module subroutine kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmi, Gmj, axi, ayi, azi, axj, ayj, azj) - !$omp declare simd(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 - end subroutine kick_getacch_int_one_pl - - pure module subroutine kick_getacch_int_one_tp(rji2, xr, yr, zr, Gmpl, ax, ay, az) - !$omp declare simd(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 - end subroutine kick_getacch_int_one_tp - - module subroutine netcdf_close(self) - implicit none - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - end subroutine netcdf_close - - module subroutine netcdf_flush(self, param) - implicit none - class(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 netcdf_flush - - module function netcdf_get_old_t_final_system(self, param) result(old_t_final) - 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) :: old_t_final !! Final time from last run - end function netcdf_get_old_t_final_system - - module subroutine netcdf_initialize_output(self, param) - implicit none - class(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 netcdf_initialize_output - - module subroutine netcdf_open(self, param, readonly) - implicit none - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - logical, optional, intent(in) :: readonly !! Logical flag indicating that this should be open read only - end subroutine netcdf_open - - module subroutine netcdf_sync(self) - implicit none - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - end subroutine netcdf_sync - - module function netcdf_read_frame_system(self, iu, param) result(ierr) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(netcdf_parameters), intent(inout) :: iu !! 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 netcdf_read_frame_system - - module subroutine netcdf_read_hdr_system(self, iu, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(netcdf_parameters), intent(inout) :: iu !! Parameters used to for reading a NetCDF dataset to file - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine netcdf_read_hdr_system - - module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpmask) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(netcdf_parameters), intent(inout) :: iu !! 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 netcdf_read_particle_info_system - - module subroutine netcdf_write_frame_base(self, iu, param) - implicit none - class(swiftest_base), intent(in) :: self !! Swiftest base object - class(netcdf_parameters), intent(inout) :: iu !! Parameters used to for writing a NetCDF dataset to file - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine netcdf_write_frame_base - - module subroutine netcdf_write_frame_system(self, iu, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(netcdf_parameters), intent(inout) :: iu !! Parameters used to for writing a NetCDF dataset to file - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine netcdf_write_frame_system - - module subroutine netcdf_write_hdr_system(self, iu, param) - implicit none - class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object - class(netcdf_parameters), intent(inout) :: iu !! Parameters used to for writing a NetCDF dataset to file - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine netcdf_write_hdr_system - - module subroutine netcdf_write_particle_info_base(self, iu, param) - implicit none - class(swiftest_base), intent(in) :: self !! Swiftest particle object - class(netcdf_parameters), intent(inout) :: iu !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine netcdf_write_particle_info_base - - module subroutine obl_acc_body(self, system) - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - end subroutine obl_acc_body - - module subroutine obl_acc_pl(self, system) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - end subroutine obl_acc_pl - - module subroutine obl_acc_tp(self, system) - implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - end subroutine obl_acc_tp - - module subroutine obl_pot_system(self) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - end subroutine obl_pot_system - - module subroutine 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 - end subroutine orbel_el2xv_vec - - pure module subroutine orbel_scget(angle, sx, cx) - !$omp declare simd(orbel_scget) - implicit none - real(DP), intent(in) :: angle - real(DP), intent(out) :: sx, cx - end subroutine orbel_scget - - pure module subroutine orbel_xv2aeq(mu, px, py, pz, vx, vy, vz, a, e, q) - !$omp declare simd(orbel_xv2aeq) - implicit none - real(DP), intent(in) :: mu !! Gravitational constant - real(DP), intent(in) :: px,py,pz !! 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 orbel_xv2aeq - - pure module subroutine orbel_xv2aqt(mu, px, py, pz, vx, vy, vz, a, q, capm, tperi) - !$omp declare simd(orbel_xv2aqt) - implicit none - real(DP), intent(in) :: mu !! Gravitational constant - real(DP), intent(in) :: px,py,pz !! 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 orbel_xv2aqt - - pure module subroutine orbel_xv2el(mu, px, py, pz, vx, vy, vz, a, e, inc, capom, omega, capm) - implicit none - real(DP), intent(in) :: mu !! Gravitational constant - real(DP), intent(in) :: px,py,pz !! 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 - end subroutine orbel_xv2el - - module subroutine 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 - end subroutine orbel_xv2el_vec - - module subroutine 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 - end subroutine setup_body - - module subroutine setup_construct_system(system, param) - implicit none - class(swiftest_nbody_system), allocatable, intent(inout) :: system !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine setup_construct_system - - module subroutine setup_finalize_system(self, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine setup_finalize_system - - module subroutine 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 - end subroutine setup_initialize_particle_info_system - - module subroutine setup_initialize_system(self, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine setup_initialize_system - - module subroutine 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 - end subroutine setup_pl - - module subroutine 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 - end subroutine setup_tp - - ! TODO: Implement the tides model - module subroutine tides_kick_getacch_pl(self, system) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - end subroutine tides_kick_getacch_pl - - module subroutine tides_step_spin_system(self, param, t, dt) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Simulation time - real(DP), intent(in) :: dt !! Current stepsize - end subroutine tides_step_spin_system - - module subroutine user_kick_getacch_body(self, system, param, t, lbeg) - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: 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 user_kick_getacch_body - end interface - - interface util_append - module subroutine util_append_arr_char_string(arr, source, nold, nsrc, lsource_mask) - implicit none - 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) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - end subroutine util_append_arr_char_string - - module subroutine util_append_arr_DP(arr, source, nold, nsrc, lsource_mask) - implicit none - real(DP), dimension(:), allocatable, intent(inout) :: arr !! Destination array - real(DP), dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - end subroutine util_append_arr_DP - - module subroutine util_append_arr_DPvec(arr, source, nold, nsrc, lsource_mask) - implicit none - real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Destination array - real(DP), dimension(:,:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - end subroutine util_append_arr_DPvec - - module subroutine util_append_arr_I4B(arr, source, nold, nsrc, lsource_mask) - implicit none - integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - end subroutine util_append_arr_I4B - - module subroutine util_append_arr_info(arr, source, nold, nsrc, 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) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - end subroutine util_append_arr_info - - module subroutine util_append_arr_logical(arr, source, nold, nsrc, lsource_mask) - implicit none - logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array - logical, dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - end subroutine util_append_arr_logical - end interface - - interface - module subroutine 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 - end subroutine util_append_body - - module subroutine 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 - end subroutine util_append_pl - - module subroutine 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 - end subroutine util_append_tp - - module subroutine 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 - end subroutine util_coord_b2h_pl - - module subroutine 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 - end subroutine util_coord_b2h_tp - - module subroutine 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 - end subroutine util_coord_h2b_pl - - module subroutine 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 - end subroutine util_coord_h2b_tp - - module subroutine 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 - end subroutine util_coord_vb2vh_pl - - module subroutine 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 - end subroutine util_coord_vb2vh_tp - - module subroutine 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 - end subroutine util_coord_vh2vb_pl - - module subroutine 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 - end subroutine util_coord_vh2vb_tp - - module subroutine util_coord_xh2xb_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 - end subroutine util_coord_xh2xb_pl - - module subroutine util_coord_xh2xb_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 - end subroutine util_coord_xh2xb_tp - - module subroutine util_copy_particle_info(self, source) - implicit none - class(swiftest_particle_info), intent(inout) :: self - class(swiftest_particle_info), intent(in) :: source - end subroutine util_copy_particle_info - - module subroutine 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 - end subroutine util_copy_particle_info_arr - - module subroutine util_dealloc_body(self) - implicit none - class(swiftest_body), intent(inout) :: self - end subroutine util_dealloc_body - - module subroutine util_dealloc_pl(self) - implicit none - class(swiftest_pl), intent(inout) :: self - end subroutine util_dealloc_pl - - module subroutine util_dealloc_system(self) - implicit none - class(swiftest_nbody_system), intent(inout) :: self - end subroutine util_dealloc_system - - module subroutine util_dealloc_tp(self) - implicit none - class(swiftest_tp), intent(inout) :: self - end subroutine util_dealloc_tp - - module subroutine util_exit(code) - implicit none - integer(I4B), intent(in) :: code !! Failure exit code - end subroutine util_exit - - module subroutine 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 - end subroutine util_fill_body - - module subroutine 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 - end subroutine util_fill_pl - - module subroutine 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 - end subroutine util_fill_tp - end interface - - interface util_fill - module subroutine util_fill_arr_char_string(keeps, inserts, lfill_list) - implicit none - 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 - end subroutine util_fill_arr_char_string - - module subroutine util_fill_arr_DP(keeps, inserts, lfill_list) - implicit none - 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 - end subroutine util_fill_arr_DP - - module subroutine util_fill_arr_DPvec(keeps, inserts, lfill_list) - implicit none - 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 - end subroutine util_fill_arr_DPvec - - module subroutine util_fill_arr_I4B(keeps, inserts, lfill_list) - implicit none - 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 - end subroutine util_fill_arr_I4B - - module subroutine 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 - end subroutine util_fill_arr_info - - module subroutine util_fill_arr_logical(keeps, inserts, lfill_list) - implicit none - 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 - end subroutine util_fill_arr_logical - end interface - - interface - pure module subroutine util_flatten_eucl_ij_to_k(n, i, j, k) - !$omp declare simd(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 - end subroutine util_flatten_eucl_ij_to_k - - pure module subroutine 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 - end subroutine util_flatten_eucl_k_to_ij - - module subroutine 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 - end subroutine - - module subroutine 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 - end subroutine - - module subroutine 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 - end subroutine util_index_array - - module function util_minimize_bfgs(f, N, x0, eps, maxloop, lerr) result(x1) - use lambda_function - implicit none - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0 - real(DP), intent(in) :: eps - logical, intent(out) :: lerr - integer(I4B), intent(in) :: maxloop - real(DP), dimension(:), allocatable :: x1 - end function util_minimize_bfgs - - module subroutine util_peri_tp(self, system, param) - implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine util_peri_tp - - - module subroutine 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. - end subroutine util_rescale_system - end interface - - - interface util_resize - module subroutine util_resize_arr_char_string(arr, nnew) - implicit none - character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size - end subroutine util_resize_arr_char_string - - module subroutine util_resize_arr_DP(arr, nnew) - implicit none - real(DP), dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size - end subroutine util_resize_arr_DP - - module subroutine util_resize_arr_DPvec(arr, nnew) - implicit none - real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size - end subroutine util_resize_arr_DPvec - - module subroutine util_resize_arr_I4B(arr, nnew) - implicit none - integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size - end subroutine util_resize_arr_I4B - - module subroutine 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 - end subroutine util_resize_arr_info - - module subroutine util_resize_arr_logical(arr, nnew) - implicit none - logical, dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size - end subroutine util_resize_arr_logical - end interface - - interface - module subroutine util_resize_body(self, nnew) - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - integer(I4B), intent(in) :: nnew !! New size neded - end subroutine util_resize_body - - module subroutine 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 - end subroutine util_resize_pl - - module subroutine 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 - end subroutine util_resize_tp - - module subroutine util_get_energy_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 - end subroutine util_get_energy_momentum_system - - module subroutine util_set_beg_end_pl(self, xbeg, xend, vbeg) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - real(DP), dimension(:,:), intent(in), optional :: xbeg !! Position vectors at beginning of step - real(DP), dimension(:,:), intent(in), optional :: xend !! 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 util_set_beg_end_pl - - module subroutine util_set_ir3h(self) - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - end subroutine util_set_ir3h - - module subroutine util_set_msys(self) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - end subroutine util_set_msys - - module subroutine 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 - end subroutine util_set_mu_pl - - module subroutine 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 - end subroutine util_set_mu_tp - - module subroutine util_set_particle_info(self, name, particle_type, status, origin_type, origin_time, collision_id, & - origin_xh, origin_vh, discard_time, discard_xh, 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_xh !! 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_xh !! 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 util_set_particle_info - - module subroutine 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 - end subroutine util_set_rhill - - module subroutine 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) - end subroutine util_set_renc_I4B - - module subroutine 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) - end subroutine util_set_renc_DP - - module subroutine 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 - end subroutine util_set_rhill_approximate - end interface - - interface util_solve_linear_system - module function util_solve_linear_system_d(A,b,n,lerr) result(x) - implicit none - integer(I4B), intent(in) :: n - real(DP), dimension(:,:), intent(in) :: A - real(DP), dimension(:), intent(in) :: b - logical, intent(out) :: lerr - real(DP), dimension(n) :: x - end function util_solve_linear_system_d - - module function util_solve_linear_system_q(A,b,n,lerr) result(x) - implicit none - integer(I4B), intent(in) :: n - real(QP), dimension(:,:), intent(in) :: A - real(QP), dimension(:), intent(in) :: b - logical, intent(out) :: lerr - real(QP), dimension(n) :: x - end function util_solve_linear_system_q - end interface - - interface - module function util_solve_rkf45(f, y0in, t1, dt0, tol) result(y1) - use lambda_function - implicit none - class(lambda_obj), intent(inout) :: f !! lambda function object that has been initialized to be a function of derivatives. The object will return with components lastarg and lasteval set - real(DP), dimension(:), intent(in) :: y0in !! Initial value at t=0 - real(DP), intent(in) :: t1 !! Final time - real(DP), intent(in) :: dt0 !! Initial step size guess - real(DP), intent(in) :: tol !! Tolerance on solution - real(DP), dimension(:), allocatable :: y1 !! Final result - end function util_solve_rkf45 - end interface - - interface util_sort - pure module subroutine util_sort_i4b(arr) - implicit none - integer(I4B), dimension(:), intent(inout) :: arr - end subroutine util_sort_i4b - - pure module subroutine util_sort_index_i4b(arr,ind) - implicit none - integer(I4B), dimension(:), intent(in) :: arr - integer(I4B), dimension(:), allocatable, intent(inout) :: ind - end subroutine util_sort_index_i4b - - pure module subroutine util_sort_index_I4B_I8Bind(arr,ind) - implicit none - integer(I4B), dimension(:), intent(in) :: arr - integer(I8B), dimension(:), allocatable, intent(inout) :: ind - end subroutine util_sort_index_I4b_I8Bind - - pure module subroutine util_sort_index_I8B_I8Bind(arr,ind) - implicit none - integer(I8B), dimension(:), intent(in) :: arr - integer(I8B), dimension(:), allocatable, intent(inout) :: ind - end subroutine util_sort_index_I8B_I8Bind - - pure module subroutine util_sort_sp(arr) - implicit none - real(SP), dimension(:), intent(inout) :: arr - end subroutine util_sort_sp - - pure module subroutine util_sort_index_sp(arr,ind) - implicit none - real(SP), dimension(:), intent(in) :: arr - integer(I4B), dimension(:), allocatable, intent(inout) :: ind - end subroutine util_sort_index_sp - - pure module subroutine util_sort_dp(arr) - implicit none - real(DP), dimension(:), intent(inout) :: arr - end subroutine util_sort_dp - - pure module subroutine util_sort_index_dp(arr,ind) - implicit none - real(DP), dimension(:), intent(in) :: arr - integer(I4B), dimension(:), allocatable, intent(inout) :: ind - end subroutine util_sort_index_dp - end interface util_sort - - interface util_sort_rearrange - pure module subroutine util_sort_rearrange_arr_char_string(arr, ind, n) - implicit none - 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 - end subroutine util_sort_rearrange_arr_char_string - - pure module subroutine util_sort_rearrange_arr_DP(arr, ind, n) - implicit none - 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 - end subroutine util_sort_rearrange_arr_DP - - pure module subroutine util_sort_rearrange_arr_DPvec(arr, ind, n) - implicit none - 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 - end subroutine util_sort_rearrange_arr_DPvec - - pure module subroutine util_sort_rearrange_arr_I4B(arr, ind, n) - implicit none - 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 - end subroutine util_sort_rearrange_arr_I4B - - pure module subroutine util_sort_rearrange_arr_I4B_I8Bind(arr, ind, n) - implicit none - 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 - end subroutine util_sort_rearrange_arr_I4B_I8Bind - - module subroutine 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 - end subroutine util_sort_rearrange_arr_info - - pure module subroutine util_sort_rearrange_arr_logical(arr, ind, n) - implicit none - 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 - end subroutine util_sort_rearrange_arr_logical - - pure module subroutine util_sort_rearrange_arr_logical_I8Bind(arr, ind, n) - implicit none - 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 - end subroutine util_sort_rearrange_arr_logical_I8Bind - end interface util_sort_rearrange - - interface - module subroutine 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) - end subroutine util_sort_rearrange_body - - module subroutine 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) - end subroutine util_sort_rearrange_pl - - module subroutine 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) - end subroutine util_sort_rearrange_tp - - module subroutine 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 - end subroutine util_sort_body - - module subroutine 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 - end subroutine util_sort_pl - - module subroutine 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 - end subroutine util_sort_tp - - end interface - - - - interface util_spill - module subroutine util_spill_arr_char_string(keeps, discards, lspill_list, ldestructive) - implicit none - 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 discardss - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not - end subroutine util_spill_arr_char_string - - module subroutine util_spill_arr_DP(keeps, discards, lspill_list, ldestructive) - implicit none - 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 discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not - end subroutine util_spill_arr_DP - - module subroutine util_spill_arr_DPvec(keeps, discards, lspill_list, ldestructive) - implicit none - 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 - end subroutine util_spill_arr_DPvec - - module subroutine util_spill_arr_I4B(keeps, discards, lspill_list, ldestructive) - implicit none - 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 discardss - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not - end subroutine util_spill_arr_I4B - - module subroutine util_spill_arr_I8B(keeps, discards, lspill_list, ldestructive) - implicit none - 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 discardss - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not - end subroutine util_spill_arr_I8B - - module subroutine 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 - end subroutine util_spill_arr_info - - module subroutine util_spill_arr_logical(keeps, discards, lspill_list, ldestructive) - implicit none - 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 discardss - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not - end subroutine util_spill_arr_logical - end interface - - interface - module subroutine 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 - end subroutine util_spill_body - - module subroutine 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 - end subroutine util_spill_pl - - module subroutine 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 - end subroutine util_spill_tp - - module subroutine 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 - end subroutine util_valid_id_system - - module subroutine util_version() - implicit none - end subroutine util_version - end interface - -end module swiftest_classes diff --git a/src/modules/swiftest_globals.f90 b/src/modules/swiftest_globals.f90 deleted file mode 100644 index 47b852f5a..000000000 --- a/src/modules/swiftest_globals.f90 +++ /dev/null @@ -1,301 +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. - -module swiftest_globals - !! author: David A. Minton - !! graph: false - !! - !! Basic parameters, definitions, and global type definitions used throughout the Swiftest project - !! Adapted from David E. Kaufmann's Swifter routine: swiftest_globals.f90 and module_swifter.f90 - use, intrinsic :: iso_fortran_env ! Use the intrinsic kind definitions - implicit none - public - - integer, parameter :: I8B = int64 !! Symbolic name for kind types of 8-byte integers - integer, parameter :: I4B = int32 !! Symbolic name for kind types of 4-byte integers - integer, parameter :: I2B = int16 !! Symbolic name for kind types of 2-byte integers - integer, parameter :: I1B = int8 !! Symbolic name for kind types of 1-byte integers - - integer, parameter :: SP = real32 !! Symbolic name for kind types of single-precision reals - integer, parameter :: DP = real64 !! Symbolic name for kind types of double-precision reals - integer, parameter :: QP = real128 !! Symbolic name for kind types of quad-precision reals - - real(DP), parameter :: PIBY2 = 1.570796326794896619231321691639751442099_DP !! Definition of /(\pi / 2\) - real(DP), parameter :: PI = 3.141592653589793238462643383279502884197_DP !! Definition of /(\pi\) - real(DP), parameter :: PI3BY2 = 4.712388980384689857693965074919254326296_DP !! Definition of /(3 \pi / 2\) - real(DP), parameter :: TWOPI = 6.283185307179586476925286766559005768394_DP !! Definition of 2 \pi - real(DP), parameter :: THIRD = 0.333333333333333333333333333333333333333_DP !! Definition of 1 / 3 - real(DP), parameter :: SIXTH = 0.166666666666666666666666666666666666667_DP !! Definition of 1 / 3 - real(DP), parameter :: DEG2RAD = PI / 180.0_DP !! Definition of conversion factor from degrees to radians - real(DP), parameter :: RAD2DEG = 180.0_DP / PI !! Definition of conversion factor from degrees to radians - real(DP), parameter :: GC = 6.6743E-11_DP !! Universal gravitational constant in SI units - real(DP), parameter :: einsteinC = 299792458.0_DP !! Speed of light in SI units - - integer(I4B), parameter :: LOWERCASE_BEGIN = iachar('a') !! ASCII character set parameter for lower to upper conversion - start of lowercase - integer(I4B), parameter :: LOWERCASE_END = iachar('z') !! ASCII character set parameter for lower to upper conversion - end of lowercase - integer(I4B), parameter :: UPPERCASE_OFFSET = iachar('A') - iachar('a') !! ASCII character set parameter for lower to upper conversion - offset between upper and lower - - real(SP), parameter :: VERSION_NUMBER = 1.0_SP !! swiftest version - - !> Symbolic name for integrator types - integer(I4B), parameter :: UNKNOWN_INTEGRATOR = 1 - integer(I4B), parameter :: BS = 2 - integer(I4B), parameter :: HELIO = 3 - integer(I4B), parameter :: RA15 = 4 - integer(I4B), parameter :: TU4 = 5 - integer(I4B), parameter :: WHM = 6 - integer(I4B), parameter :: RMVS = 7 - integer(I4B), parameter :: SYMBA = 8 - integer(I4B), parameter :: RINGMOONS = 9 - - integer(I4B), parameter :: STRMAX = 512 !! Maximum size of character strings - integer(I4B), parameter :: NAMELEN = 32 !! Maximum size of name strings - - character(*), parameter :: ASCII_TYPE = 'ASCII' !! Symbolic name for ASCII file type - character(*), parameter :: REAL4_TYPE = 'REAL4' !! Symbolic name for binary file type REAL4 - character(*), parameter :: REAL8_TYPE = 'REAL8' !! Symbolic name for binary file type REAL8 - character(*), parameter :: NETCDF_FLOAT_TYPE = 'NETCDF_FLOAT' !! Symbolic name for binary file type REAL8 - character(*), parameter :: NETCDF_DOUBLE_TYPE = 'NETCDF_DOUBLE' !! Symbolic name for binary file type REAL8 - - character(*), parameter :: EL = 'EL' !! Symbolic name for binary output file contents for orbital elements - character(*), parameter :: XV = 'XV' !! Symbolic name for binary output file contents for cartesian position and velocity vectors - character(*), parameter :: XVEL = 'XVEL' !! Symbolic name for binary output file contents for both cartesian position and velocity and orbital elements - - character(*), parameter :: CB_TYPE_NAME = "Central Body" - character(*), parameter :: PL_TYPE_NAME = "Massive Body" - character(*), parameter :: TP_TYPE_NAME = "Test Particle" - character(*), parameter :: PL_TINY_TYPE_NAME = "Semi-Interacting Massive Body" - - ! OpenMP Parameters - integer(I4B) :: nthreads = 1 !! Number of OpenMP threads - integer(I4B), parameter :: NTHERSHOLD = 1000 !! Threshold value for OpenMP loop parallelization - - integer(I4B), parameter :: SUCCESS = 0 !! Symbolic name for function return/flag code for success - integer(I4B), parameter :: FAILURE = -1 !! Symbolic name for function return/flag code for failure - integer(I4B), parameter :: USAGE = -2 !! Symbolic name for function return/flag code for printing the usage message - integer(I4B), parameter :: HELP = -3 !! Symbolic name for function return/flag code for printing the usage message - - character(*), parameter :: SUCCESS_MSG = '(/, "Normal termination of Swiftest (version ", f3.1, ")")' - character(*), parameter :: FAIL_MSG = '(/, "Terminating Swiftest (version ", f3.1, ") due to error!!")' - character(*), parameter :: USAGE_MSG = '("Usage: swiftest [bs|helio|ra15|rmvs|symba|tu4|whm] ")' - character(*), parameter :: HELP_MSG = USAGE_MSG - - integer(I4B), parameter :: ELLIPSE = -1 !! Symbolic names for orbit types - ellipse - integer(I4B), parameter :: PARABOLA = 0 !! Symbolic names for orbit types - parabola - integer(I4B), parameter :: HYPERBOLA = 1 !! Symbolic names for orbit types - hyperbola - - !> Symbolic names for body/particle status codes: - integer(I4B), parameter :: ACTIVE = 0 - integer(I4B), parameter :: INACTIVE = 1 - integer(I4B), parameter :: DISCARDED_RMAX = -1 - integer(I4B), parameter :: DISCARDED_RMIN = -2 - integer(I4B), parameter :: DISCARDED_RMAXU = -3 - integer(I4B), parameter :: DISCARDED_PERI = -4 - integer(I4B), parameter :: DISCARDED_PLR = -5 - integer(I4B), parameter :: DISCARDED_PLQ = -6 - integer(I4B), parameter :: DISCARDED_DRIFTERR = -7 - integer(I4B), parameter :: MERGED = -8 - integer(I4B), parameter :: DISRUPTION = -9 - integer(I4B), parameter :: SUPERCATASTROPHIC = -10 - integer(I4B), parameter :: GRAZE_AND_MERGE = -11 - integer(I4B), parameter :: HIT_AND_RUN_DISRUPT = -12 - integer(I4B), parameter :: HIT_AND_RUN_PURE = -13 - integer(I4B), parameter :: COLLISION = -14 - integer(I4B), parameter :: NEW_PARTICLE = -15 - integer(I4B), parameter :: OLD_PARTICLE = -16 - - !>Symbolic names for collisional outcomes from collresolve_resolve: - integer(I4B), parameter :: COLLRESOLVE_REGIME_MERGE = 1 - integer(I4B), parameter :: COLLRESOLVE_REGIME_DISRUPTION = 2 - integer(I4B), parameter :: COLLRESOLVE_REGIME_SUPERCATASTROPHIC = 3 - integer(I4B), parameter :: COLLRESOLVE_REGIME_GRAZE_AND_MERGE = 4 - integer(I4B), parameter :: COLLRESOLVE_REGIME_HIT_AND_RUN = 5 - - !> String labels for body/particle addition/subtraction in discard file - character(*), parameter :: ADD = '+1' - character(*), parameter :: SUB = '-1' - - !> Standard file names - integer(I4B), parameter :: NDUMPFILES = 2 - character(*), dimension(2), parameter :: DUMP_CB_FILE = ['dump_cb1.bin', 'dump_cb2.bin' ] - character(*), dimension(2), parameter :: DUMP_PL_FILE = ['dump_pl1.bin', 'dump_pl2.bin' ] - character(*), dimension(2), parameter :: DUMP_TP_FILE = ['dump_tp1.bin', 'dump_tp2.bin' ] - character(*), dimension(2), parameter :: DUMP_NC_FILE = ['dump_bin1.nc', 'dump_bin2.nc' ] - character(*), dimension(2), parameter :: DUMP_PARAM_FILE = ['dump_param1.in', 'dump_param2.in'] - - !> Default file names that can be changed by the user in the parameters file - character(*), parameter :: CB_INFILE = 'cb.in' - character(*), parameter :: PL_INFILE = 'pl.in' - character(*), parameter :: TP_INFILE = 'tp.in' - character(*), parameter :: NC_INFILE = 'in.nc' - character(*), parameter :: BIN_OUTFILE = 'bin.nc' - integer(I4B), parameter :: BINUNIT = 20 !! File unit number for the binary output file - character(*), parameter :: PARTICLE_OUTFILE = 'particle.dat' - integer(I4B), parameter :: PARTICLEUNIT = 44 !! File unit number for the binary particle info output file - integer(I4B), parameter :: LUN = 42 !! File unit number for files that are opened and closed within a single subroutine call, and therefore should not collide - - !> Miscellaneous constants: - integer(I4B), parameter :: NDIM = 3 !! Number of dimensions in our reality - integer(I4B), parameter :: NDIM2 = 2 * NDIM !! 2x the number of dimensions - real(DP), parameter :: VSMALL = 2 * epsilon(1._DP) !! Very small number used to prevent floating underflow - - !> NetCDF variable names and constants - character(*), parameter :: NETCDF_OUTFILE = 'bin.nc' !! Default output file name - character(*), parameter :: TIME_DIMNAME = "time" !! NetCDF name of the time dimension - character(*), parameter :: ID_DIMNAME = "id" !! NetCDF name of the particle id dimension - character(*), parameter :: STR_DIMNAME = "str" !! NetCDF name of the particle id dimension - character(*), parameter :: PTYPE_VARNAME = "particle_type" !! NetCDF name of the particle type variable - character(*), parameter :: NAME_VARNAME = "name" !! NetCDF name of the particle name variable - character(*), parameter :: NPL_VARNAME = "npl" !! NetCDF name of the number of active massive bodies variable - character(*), parameter :: NTP_VARNAME = "ntp" !! NetCDF name of the number of active test particles variable - character(*), parameter :: NPLM_VARNAME = "nplm" !! NetCDF name of the number of active fully interacting massive bodies variable (SyMBA) - character(*), parameter :: A_VARNAME = "a" !! NetCDF name of the semimajor axis variable - character(*), parameter :: E_VARNAME = "e" !! NetCDF name of the eccentricity variable - character(*), parameter :: INC_VARNAME = "inc" !! NetCDF name of the inclination variable - character(*), parameter :: CAPOM_VARNAME = "capom" !! NetCDF name of the long. asc. node variable - character(*), parameter :: OMEGA_VARNAME = "omega" !! NetCDF name of the arg. periapsis variable - character(*), parameter :: CAPM_VARNAME = "capm" !! NetCDF name of the mean anomaly variable - character(*), parameter :: XHX_VARNAME = "xhx" !! NetCDF name of the heliocentric position x variable - character(*), parameter :: XHY_VARNAME = "xhy" !! NetCDF name of the heliocentric position y variable - character(*), parameter :: XHZ_VARNAME = "xhz" !! NetCDF name of the heliocentric position z variable - character(*), parameter :: VHX_VARNAME = "vhx" !! NetCDF name of the heliocentric velocity x variable - character(*), parameter :: VHY_VARNAME = "vhy" !! NetCDF name of the heliocentric velocity y variable - character(*), parameter :: VHZ_VARNAME = "vhz" !! NetCDF name of the heliocentric velocity z variable - character(*), parameter :: GR_PSEUDO_VHX_VARNAME = "gr_pseudo_vhx" !! NetCDF name of the heliocentric pseudovelocity x variable (used in GR only) - character(*), parameter :: GR_PSEUDO_VHY_VARNAME = "gr_pseudo_vhy" !! NetCDF name of the heliocentric pseudovelocity y variable (used in GR only) - character(*), parameter :: GR_PSEUDO_VHZ_VARNAME = "gr_pseudo_vhz" !! NetCDF name of the heliocentric pseudovelocity z variable (used in GR only) - character(*), parameter :: GMASS_VARNAME = "Gmass" !! NetCDF name of the mass variable - character(*), parameter :: RHILL_VARNAME = "rhill" !! NetCDF name of the hill radius variable - character(*), parameter :: RADIUS_VARNAME = "radius" !! NetCDF name of the radius variable - character(*), parameter :: IP1_VARNAME = "Ip1" !! NetCDF name of the axis 1 principal moment of inertial variable - character(*), parameter :: IP2_VARNAME = "Ip2" !! NetCDF name of the axis 2 principal moment of inertial variable - character(*), parameter :: IP3_VARNAME = "Ip3" !! NetCDF name of the axis 3 principal moment of inertial variable - character(*), parameter :: ROTX_VARNAME = "rotx" !! NetCDF name of the rotation x variable - character(*), parameter :: ROTY_VARNAME = "roty" !! NetCDF name of the rotation y variable - character(*), parameter :: ROTZ_VARNAME = "rotz" !! NetCDF name of the rotation z variable - character(*), parameter :: K2_VARNAME = "k2" !! NetCDF name of the Love number variable - character(*), parameter :: Q_VARNAME = "Q" !! NetCDF name of the energy dissipation variable - character(*), parameter :: KE_ORB_VARNAME = "KE_orb" !! NetCDF name of the system orbital kinetic energy variable - character(*), parameter :: KE_SPIN_VARNAME = "KE_spin" !! NetCDF name of the system spin kinetic energy variable - character(*), parameter :: PE_VARNAME = "PE" !! NetCDF name of the system potential energy variable - character(*), parameter :: L_ORBX_VARNAME = "L_orbx" !! NetCDF name of the orbital angular momentum x variable - character(*), parameter :: L_ORBY_VARNAME = "L_orby" !! NetCDF name of the orbital angular momentum y variable - character(*), parameter :: L_ORBZ_VARNAME = "L_orbz" !! NetCDF name of the orbital angular momentum z variable - character(*), parameter :: L_SPINX_VARNAME = "L_spinx" !! NetCDF name of the spin angular momentum x variable - character(*), parameter :: L_SPINY_VARNAME = "L_spiny" !! NetCDF name of the spin angular momentum y variable - character(*), parameter :: L_SPINZ_VARNAME = "L_spinz" !! NetCDF name of the spin angular momentum z variable - character(*), parameter :: L_ESCAPEX_VARNAME = "L_escapex" !! NetCDF name of the escaped angular momentum x variable - character(*), parameter :: L_ESCAPEY_VARNAME = "L_escapey" !! NetCDF name of the escaped angular momentum y variable - character(*), parameter :: L_ESCAPEZ_VARNAME = "L_escapez" !! NetCDF name of the escaped angular momentum z variable - character(*), parameter :: ECOLLISIONS_VARNAME = "Ecollisions" !! NetCDF name of the escaped angular momentum y variable - character(*), parameter :: EUNTRACKED_VARNAME = "Euntracked" !! NetCDF name of the energy that is untracked due to loss (untracked potential energy due to mergers and body energy for escaped bodies) - character(*), parameter :: GMESCAPE_VARNAME = "GMescape" !! NetCDF name of the G*Mass of bodies that escape the system - character(*), parameter :: STATUS_VARNAME = "status" !! NetCDF name of the current status of the body variable (includes discard type) - character(*), parameter :: ORIGIN_TYPE_VARNAME = "origin_type" !! NetCDF name of the origin type variable (Initial Conditions, Disruption, etc.) - character(*), parameter :: ORIGIN_TIME_VARNAME = "origin_time" !! NetCDF name of the time of origin variable - character(*), parameter :: COLLISION_ID_VARNAME = "collision_id" !! NetCDF name of the collision id variable - character(*), parameter :: ORIGIN_XHX_VARNAME = "origin_xhx" !! NetCDF name of the heliocentric position of the body at the time of origin x variable - character(*), parameter :: ORIGIN_XHY_VARNAME = "origin_xhy" !! NetCDF name of the heliocentric position of the body at the time of origin y variable - character(*), parameter :: ORIGIN_XHZ_VARNAME = "origin_xhz" !! NetCDF name of the heliocentric position of the body at the time of origin z variable - character(*), parameter :: ORIGIN_VHX_VARNAME = "origin_vhx" !! NetCDF name of the heliocentric velocity of the body at the time of origin x variable - character(*), parameter :: ORIGIN_VHY_VARNAME = "origin_vhy" !! NetCDF name of the heliocentric velocity of the body at the time of origin y variable - character(*), parameter :: ORIGIN_VHZ_VARNAME = "origin_vhz" !! NetCDF name of the heliocentric velocity of the body at the time of origin z variable - character(*), parameter :: DISCARD_TIME_VARNAME = "discard_time" !! NetCDF name of the time of discard variable - character(*), parameter :: DISCARD_XHX_VARNAME = "discard_xhx" !! NetCDF name of the heliocentric position of the body at the time of discard x variable - character(*), parameter :: DISCARD_XHY_VARNAME = "discard_xhy" !! NetCDF name of the heliocentric position of the body at the time of discard y variable - character(*), parameter :: DISCARD_XHZ_VARNAME = "discard_xhz" !! NetCDF name of the heliocentric position of the body at the time of discard z variable - character(*), parameter :: DISCARD_VHX_VARNAME = "discard_vhx" !! NetCDF name of the heliocentric velocity of the body at the time of discard x variable - character(*), parameter :: DISCARD_VHY_VARNAME = "discard_vhy" !! NetCDF name of the heliocentric velocity of the body at the time of discard y variable - character(*), parameter :: DISCARD_VHZ_VARNAME = "discard_vhz" !! NetCDF name of the heliocentric velocity of the body at the time of discard z variable - character(*), parameter :: DISCARD_BODY_ID_VARNAME = "discard_body_id" !! NetCDF name of the id of the other body involved in the discard - character(*), parameter :: J2RP2_VARNAME = "j2rp2" !! NetCDF name of the j2rp2 variable - character(*), parameter :: J4RP4_VARNAME = "j4rp4" !! NetCDF name of the j4pr4 variable - - !! 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 swiftest_classes - type :: netcdf_variables - integer(I4B) :: out_type !! NetCDF output type (will be assigned either NF90_DOUBLE or NF90_FLOAT, depending on the user parameter) - integer(I4B) :: ncid !! NetCDF ID for the output file - integer(I4B) :: dimids(3) !! Dimensions of the NetCDF file - integer(I4B) :: time_dimid !! NetCDF ID for the time dimension - integer(I4B) :: id_dimid !! NetCDF ID for the particle id dimension - integer(I4B) :: str_dimid !! NetCDF ID for the character string dimension - integer(I4B) :: time_varid !! NetCDF ID for the time variable - integer(I4B) :: id_varid !! NetCDF ID for the particle name variable - integer(I4B) :: name_varid !! NetCDF ID for the namevariable - integer(I4B) :: ptype_varid !! NetCDF ID for the particle type variable - integer(I4B) :: npl_varid !! NetCDF ID for the number of active massive bodies variable - integer(I4B) :: ntp_varid !! NetCDF ID for the number of active test particles variable - integer(I4B) :: nplm_varid !! NetCDF ID for the number of active fully interacting massive bodies variable (SyMBA) - integer(I4B) :: a_varid !! NetCDF ID for the semimajor axis variable - integer(I4B) :: e_varid !! NetCDF ID for the eccentricity variable - integer(I4B) :: inc_varid !! NetCDF ID for the inclination variable - integer(I4B) :: capom_varid !! NetCDF ID for the long. asc. node variable - integer(I4B) :: omega_varid !! NetCDF ID for the arg. periapsis variable - integer(I4B) :: capm_varid !! NetCDF ID for the mean anomaly variable - integer(I4B) :: xhx_varid !! NetCDF ID for the heliocentric position x variable - integer(I4B) :: xhy_varid !! NetCDF ID for the heliocentric position y variable - integer(I4B) :: xhz_varid !! NetCDF ID for the heliocentric position z variable - integer(I4B) :: vhx_varid !! NetCDF ID for the heliocentric velocity x variable - integer(I4B) :: vhy_varid !! NetCDF ID for the heliocentric velocity y variable - integer(I4B) :: vhz_varid !! NetCDF ID for the heliocentric velocity z variable - integer(I4B) :: gr_pseudo_vhx_varid !! NetCDF ID for the heliocentric pseudovelocity x variable (used in GR) - integer(I4B) :: gr_pseudo_vhy_varid !! NetCDF ID for the heliocentric pseudovelocity y variable (used in GR) - integer(I4B) :: gr_pseudo_vhz_varid !! NetCDF ID for the heliocentric psuedovelocity z variable (used in GR) - integer(I4B) :: Gmass_varid !! NetCDF ID for the mass variable - integer(I4B) :: rhill_varid !! NetCDF ID for the hill radius variable - integer(I4B) :: radius_varid !! NetCDF ID for the radius variable - integer(I4B) :: Ip1_varid !! NetCDF ID for the axis 1 principal moment of inertia variable - integer(I4B) :: Ip2_varid !! NetCDF ID for the axis 2 principal moment of inertia variable - integer(I4B) :: Ip3_varid !! NetCDF ID for the axis 3 principal moment of inertia variable - integer(I4B) :: rotx_varid !! NetCDF ID for the rotation x variable - integer(I4B) :: roty_varid !! NetCDF ID for the rotation y variable - integer(I4B) :: rotz_varid !! NetCDF ID for the rotation z variable - integer(I4B) :: j2rp2_varid !! NetCDF ID for the j2 variable - integer(I4B) :: j4rp4_varid !! NetCDF ID for the j4 variable - integer(I4B) :: k2_varid !! NetCDF ID for the Love number variable - integer(I4B) :: Q_varid !! NetCDF ID for the energy dissipation variable - integer(I4B) :: KE_orb_varid !! NetCDF ID for the system orbital kinetic energy variable - integer(I4B) :: KE_spin_varid !! NetCDF ID for the system spin kinetic energy variable - integer(I4B) :: PE_varid !! NetCDF ID for the system potential energy variable - integer(I4B) :: L_orbx_varid !! NetCDF ID for the system orbital angular momentum x variable - integer(I4B) :: L_orby_varid !! NetCDF ID for the system orbital angular momentum y variable - integer(I4B) :: L_orbz_varid !! NetCDF ID for the system orbital angular momentum z variable - integer(I4B) :: L_spinx_varid !! NetCDF ID for the system spin angular momentum x variable - integer(I4B) :: L_spiny_varid !! NetCDF ID for the system spin angular momentum y variable - integer(I4B) :: L_spinz_varid !! NetCDF ID for the system spin angular momentum z variable - integer(I4B) :: L_escapex_varid !! NetCDF ID for the escaped angular momentum x variable - integer(I4B) :: L_escapey_varid !! NetCDF ID for the escaped angular momentum x variable - integer(I4B) :: L_escapez_varid !! NetCDF ID for the escaped angular momentum x variable - integer(I4B) :: Ecollisions_varid !! NetCDF ID for the energy lost in collisions variable - integer(I4B) :: Euntracked_varid !! NetCDF ID for the energy that is untracked due to loss (untracked potential energy due to mergers and body energy for escaped bodies) - integer(I4B) :: GMescape_varid !! NetCDF ID for the G*Mass of bodies that escape the system - integer(I4B) :: status_varid !! NetCDF ID for the status variable - integer(I4B) :: origin_type_varid !! NetCDF ID for the origin type - integer(I4B) :: origin_time_varid !! NetCDF ID for the origin time - integer(I4B) :: collision_id_varid !! Netcdf ID for the origin collision ID - integer(I4B) :: origin_xhx_varid !! NetCDF ID for the origin xh x component - integer(I4B) :: origin_xhy_varid !! NetCDF ID for the origin xh y component - integer(I4B) :: origin_xhz_varid !! NetCDF ID for the origin xh z component - integer(I4B) :: origin_vhx_varid !! NetCDF ID for the origin xh x component - integer(I4B) :: origin_vhy_varid !! NetCDF ID for the origin xh y component - integer(I4B) :: origin_vhz_varid !! NetCDF ID for the origin xh z component - integer(I4B) :: discard_time_varid !! NetCDF ID for the time of discard variable - integer(I4B) :: discard_xhx_varid !! NetCDF ID for the heliocentric position of the body at the time of discard x variable - integer(I4B) :: discard_xhy_varid !! NetCDF ID for the heliocentric position of the body at the time of discard y variable - integer(I4B) :: discard_xhz_varid !! NetCDF ID for the heliocentric position of the body at the time of discard z variable - integer(I4B) :: discard_vhx_varid !! NetCDF ID for the heliocentric velocity of the body at the time of discard x variable - integer(I4B) :: discard_vhy_varid !! NetCDF ID for the heliocentric velocity of the body at the time of discard y variable - integer(I4B) :: discard_vhz_varid !! NetCDF ID for the heliocentric velocity of the body at the time of discard z variable - integer(I4B) :: discard_body_id_varid !! NetCDF ID for the id of the other body involved in the discard - integer(I4B) :: id_chunk !! Chunk size for the id dimension variables - integer(I4B) :: time_chunk !! Chunk size for the time dimension variables - logical :: lpseudo_vel_exists = .false. !! Logical flag to indicate whether or not the pseudovelocity vectors were present in an old file. - end type netcdf_variables - -end module swiftest_globals diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 deleted file mode 100644 index cacad4b4d..000000000 --- a/src/modules/symba_classes.f90 +++ /dev/null @@ -1,782 +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. - -module symba_classes - !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Definition of classes and methods specific to the SyMBA integrator - !! Adapted from David E. Kaufmann's Swifter routine: module_symba.f90 - use swiftest_globals - use swiftest_classes, only : swiftest_parameters, swiftest_base, swiftest_particle_info, netcdf_parameters - use helio_classes, only : helio_cb, helio_pl, helio_tp, helio_nbody_system - use fraggle_classes, only : fraggle_colliders, fraggle_fragments - use encounter_classes, only : encounter_list - implicit none - public - - integer(I4B), private, parameter :: NENMAX = 32767 - integer(I4B), private, parameter :: NTENC = 3 - real(DP), private, parameter :: RHSCALE = 6.5_DP - real(DP), private, parameter :: RSHELL = 0.48075_DP - - type, extends(swiftest_parameters) :: symba_parameters - 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 - integer(I4B), dimension(:), allocatable :: seed !! Random seeds - logical :: lfragmentation = .false. !! Do fragmentation modeling instead of simple merger. - contains - procedure :: reader => symba_io_param_reader - procedure :: writer => symba_io_param_writer - end type symba_parameters - - !******************************************************************************************************************************** - ! symba_kinship class definitions and method interfaces - !******************************************************************************************************************************* - !> Class definition for the kinship relationships used in bookkeeping multiple collisions bodies in a single time step. - type symba_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 - contains - procedure :: dealloc => symba_util_dealloc_kin !! Deallocates all allocatable arrays - final :: symba_util_final_kin !! Finalizes the SyMBA kinship object - deallocates all allocatables - end type symba_kinship - - !******************************************************************************************************************************** - ! symba_cb class definitions and method interfaces - !******************************************************************************************************************************* - !> SyMBA central body particle class - type, extends(helio_cb) :: symba_cb - 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 - end type symba_cb - - !******************************************************************************************************************************** - ! symba_pl class definitions and method interfaces - !******************************************************************************************************************************* - !> SyMBA massive body class - type, extends(helio_pl) :: symba_pl - 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 - logical, dimension(:), allocatable :: lmtiny !! flag indicating whether this body is below the GMTINY cutoff value - integer(I4B) :: nplm !! 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 - integer(I4B), dimension(:), allocatable :: levelg !! level at which this body should be moved - integer(I4B), dimension(:), allocatable :: levelm !! deepest encounter level achieved this time step - 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 - type(symba_kinship), dimension(:), allocatable :: kin !! Array of merger relationship structures that can account for multiple pairwise mergers in a single step - contains - procedure :: make_colliders => symba_collision_make_colliders_pl !! When a single body is involved in more than one collision in a single step, it becomes part of a family - procedure :: flatten => symba_util_flatten_eucl_plpl !! Sets up the (i, j) -> k indexing used for the single-loop blocking Euclidean distance matrix - procedure :: discard => symba_discard_pl !! Process massive body discards - procedure :: drift => symba_drift_pl !! Method for Danby drift in Democratic Heliocentric coordinates. Sets the mask to the current recursion level - procedure :: encounter_check => symba_encounter_check_pl !! Checks if massive bodies are going through close encounters with each other - procedure :: gr_pos_kick => symba_gr_p4_pl !! Position kick due to p**4 term in the post-Newtonian correction - procedure :: accel_int => symba_kick_getacch_int_pl !! Compute direct cross (third) term heliocentric accelerations of massive bodiess, with no mutual interactions between bodies below GMTINY - procedure :: accel => symba_kick_getacch_pl !! Compute heliocentric accelerations of massive bodies - procedure :: setup => symba_setup_pl !! Constructor method - Allocates space for the input number of bodies - procedure :: append => symba_util_append_pl !! Appends elements from one structure to another - procedure :: dealloc => symba_util_dealloc_pl !! Deallocates all allocatable arrays - procedure :: fill => symba_util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) - procedure :: get_peri => symba_util_peri_pl !! Determine system pericenter passages for massive bodies - procedure :: rearray => symba_util_rearray_pl !! Clean up the massive body structures to remove discarded bodies and add new bodies - procedure :: reset_kinship => symba_util_reset_kinship !! Resets the kinship status of bodies - procedure :: resize => symba_util_resize_pl !! Checks the current size of a SyMBA massive body against the requested size and resizes it if it is too small. - procedure :: set_renc_I4B => symba_util_set_renc !! Sets the critical radius for encounter given an input recursion depth - procedure :: sort => symba_util_sort_pl !! Sorts body arrays by a sortable componen - procedure :: rearrange => symba_util_sort_rearrange_pl !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods - procedure :: spill => symba_util_spill_pl !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - final :: symba_util_final_pl !! Finalizes the SyMBA massive body object - deallocates all allocatables - end type symba_pl - - type, extends(symba_pl) :: symba_merger - integer(I4B), dimension(:), allocatable :: ncomp - contains - procedure :: append => symba_util_append_merger !! Appends elements from one structure to another - procedure :: dealloc => symba_util_dealloc_merger !! Deallocates all allocatable arrays - procedure :: resize => symba_util_resize_merger !! Checks the current size of a SyMBA merger list against the requested size and resizes it if it is too small. - procedure :: setup => symba_setup_merger !! Constructor method - Allocates space for the input number of bodies - final :: symba_util_final_merger !! Finalizes the SyMBA merger object - deallocates all allocatables - end type symba_merger - - !******************************************************************************************************************************** - ! symba_tp class definitions and method interfaces - !******************************************************************************************************************************* - !> SyMBA test particle class - type, extends(helio_tp) :: symba_tp - integer(I4B), dimension(:), allocatable :: nplenc !! number of encounters with planets this time step - integer(I4B), dimension(:), allocatable :: levelg !! level at which this particle should be moved - integer(I4B), dimension(:), allocatable :: levelm !! deepest encounter level achieved this time step - contains - procedure :: drift => symba_drift_tp !! Method for Danby drift in Democratic Heliocentric coordinates. Sets the mask to the current recursion level - procedure :: encounter_check => symba_encounter_check_tp !! Checks if any test particles are undergoing a close encounter with a massive body - procedure :: gr_pos_kick => symba_gr_p4_tp !! Position kick due to p**4 term in the post-Newtonian correction - procedure :: accel => symba_kick_getacch_tp !! Compute heliocentric accelerations of test particles - procedure :: setup => symba_setup_tp !! Constructor method - Allocates space for the input number of bodies - procedure :: append => symba_util_append_tp !! Appends elements from one structure to another - procedure :: dealloc => symba_util_dealloc_tp !! Deallocates all allocatable arrays - procedure :: fill => symba_util_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) - procedure :: resize => symba_util_resize_tp !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. - procedure :: sort => symba_util_sort_tp !! Sorts body arrays by a sortable componen - procedure :: rearrange => symba_util_sort_rearrange_tp !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods - procedure :: spill => symba_util_spill_tp !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - final :: symba_util_final_tp !! Finalizes the SyMBA test particle object - deallocates all allocatables - end type symba_tp - - !******************************************************************************************************************************** - ! symba_encounter class definitions and method interfaces - !******************************************************************************************************************************* - !> SyMBA class for tracking close encounters in a step - type, extends(encounter_list) :: symba_encounter - integer(I4B), dimension(:), allocatable :: level !! encounter recursion level - contains - procedure :: collision_check => symba_collision_check_encounter !! Checks if a test particle is going to collide with a massive body - procedure :: encounter_check => symba_encounter_check !! Checks if massive bodies are going through close encounters with each other - procedure :: kick => symba_kick_encounter !! Kick barycentric velocities of active test particles within SyMBA recursion - procedure :: setup => symba_setup_encounter_list !! A constructor that sets the number of encounters and allocates and initializes all arrays - procedure :: copy => symba_util_copy_encounter_list !! Copies elements from the source encounter list into self. - procedure :: dealloc => symba_util_dealloc_encounter_list !! Deallocates all allocatable arrays - procedure :: spill => symba_util_spill_encounter_list !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - procedure :: append => symba_util_append_encounter_list !! Appends elements from one structure to another - final :: symba_util_final_encounter_list !! Finalizes the SyMBA test particle object - deallocates all allocatables - end type symba_encounter - - !******************************************************************************************************************************** - ! symba_pltpenc class definitions and method interfaces - !******************************************************************************************************************************* - !> SyMBA class for tracking pl-tp close encounters in a step - type, extends(symba_encounter) :: symba_pltpenc - contains - procedure :: resolve_collision => symba_collision_resolve_pltpenc !! Process the pl-tp collision list, then modifiy the massive bodies based on the outcome of the c - end type symba_pltpenc - - !******************************************************************************************************************************** - ! symba_plplenc class definitions and method interfaces - !******************************************************************************************************************************* - !> SyMBA class for tracking pl-pl close encounters in a step - type, extends(symba_encounter) :: symba_plplenc - contains - procedure :: extract_collisions => symba_collision_encounter_extract_collisions !! Processes the pl-pl encounter list remove only those encounters that led to a collision - procedure :: resolve_fragmentations => symba_collision_resolve_fragmentations !! Process list of collisions, determine the collisional regime, and then create fragments - procedure :: resolve_mergers => symba_collision_resolve_mergers !! Process list of collisions and merge colliding bodies together - procedure :: resolve_collision => symba_collision_resolve_plplenc !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the c - end type symba_plplenc - - !******************************************************************************************************************************** - ! symba_nbody_system class definitions and method interfaces - !******************************************************************************************************************************** - type, extends(helio_nbody_system) :: symba_nbody_system - class(symba_merger), allocatable :: pl_adds !! List of added bodies in mergers or collisions - class(symba_pltpenc), allocatable :: pltpenc_list !! List of massive body-test particle encounters in a single step - class(symba_plplenc), allocatable :: plplenc_list !! List of massive body-massive body encounters in a single step - class(symba_plplenc), allocatable :: plplcollision_list !! List of massive body-massive body collisions in a single step - integer(I4B) :: irec !! System recursion level - contains - procedure :: write_discard => symba_io_write_discard !! Write out information about discarded and merged planets and test particles in SyMBA - procedure :: initialize => symba_setup_initialize_system !! Performs SyMBA-specific initilization steps - procedure :: step => symba_step_system !! Advance the SyMBA nbody system forward in time by one step - procedure :: interp => symba_step_interp_system !! Perform an interpolation step on the SymBA nbody system - procedure :: set_recur_levels => symba_step_set_recur_levels_system !! Sets recursion levels of bodies and encounter lists to the current system level - procedure :: recursive_step => symba_step_recur_system !! Step interacting planets and active test particles ahead in democratic heliocentric coordinates at the current recursion level, if applicable, and descend to the next deeper level if necessary - procedure :: reset => symba_step_reset_system !! Resets pl, tp,and encounter structures at the start of a new step - procedure :: dealloc => symba_util_dealloc_system !! Deallocates all allocatable arrays - final :: symba_util_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables - end type symba_nbody_system - - interface - module function symba_collision_check_encounter(self, system, param, t, dt, irec) result(lany_collision) - use swiftest_classes, only : swiftest_parameters - implicit none - class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: 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 :: lany_collision !! Returns true if cany pair of encounters resulted in a collision n - end function symba_collision_check_encounter - - module subroutine symba_collision_encounter_extract_collisions(self, system, param) - implicit none - class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine - - module subroutine symba_collision_make_colliders_pl(self,idx) - implicit none - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - integer(I4B), dimension(2), intent(in) :: idx !! Array holding the indices of the two bodies involved in the collision - end subroutine symba_collision_make_colliders_pl - - module subroutine symba_collision_resolve_fragmentations(self, system, param) - implicit none - class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - end subroutine symba_collision_resolve_fragmentations - - module subroutine symba_collision_resolve_mergers(self, system, param) - implicit none - class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - end subroutine symba_collision_resolve_mergers - - module subroutine symba_collision_resolve_plplenc(self, system, param, t, dt, irec) - implicit none - class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Current simulation time - real(DP), intent(in) :: dt !! Current simulation step size - integer(I4B), intent(in) :: irec !! Current recursion level - end subroutine symba_collision_resolve_plplenc - - module subroutine symba_collision_resolve_pltpenc(self, system, param, t, dt, irec) - implicit none - class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-tp encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Current simulation time - real(DP), intent(in) :: dt !! Current simulation step size - integer(I4B), intent(in) :: irec !! Current recursion level - end subroutine symba_collision_resolve_pltpenc - - module subroutine symba_discard_pl(self, system, param) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters - implicit none - class(symba_pl), intent(inout) :: self !! SyMBA test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine symba_discard_pl - - module subroutine symba_drift_pl(self, system, param, dt) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters - implicit none - class(symba_pl), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: dt !! Stepsize - end subroutine symba_drift_pl - - module subroutine symba_drift_tp(self, system, param, dt) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters - implicit none - class(symba_tp), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: dt !! Stepsize - end subroutine symba_drift_tp - - module function symba_encounter_check_pl(self, param, system, dt, irec) result(lany_encounter) - use swiftest_classes, only : swiftest_nbody_system - implicit none - class(symba_pl), intent(inout) :: self !! SyMBA test particle object - class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - real(DP), intent(in) :: dt !! step size - integer(I4B), intent(in) :: irec !! Current recursion level - logical :: lany_encounter !! Returns true if there is at least one close encounter - end function symba_encounter_check_pl - - module function symba_encounter_check(self, param, system, dt, irec) result(lany_encounter) - use swiftest_classes, only : swiftest_parameters - implicit none - class(symba_encounter), intent(inout) :: self !! SyMBA pl-pl encounter list object - class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - real(DP), intent(in) :: dt !! step size - integer(I4B), intent(in) :: irec !! Current recursion level - logical :: lany_encounter !! Returns true if there is at least one close encounter - end function symba_encounter_check - - module function symba_encounter_check_tp(self, param, system, dt, irec) result(lany_encounter) - use swiftest_classes, only : swiftest_parameters - implicit none - class(symba_tp), intent(inout) :: self !! SyMBA test particle object - class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - real(DP), intent(in) :: dt !! step size - integer(I4B), intent(in) :: irec !! Current recursion level - logical :: lany_encounter !! Returns true if there is at least one close encounter - end function symba_encounter_check_tp - - pure module subroutine symba_gr_p4_pl(self, system, param, dt) - use swiftest_classes, only : swiftest_parameters, swiftest_nbody_system - implicit none - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: dt !! Step size - end subroutine symba_gr_p4_pl - - pure module subroutine symba_gr_p4_tp(self, system, param, dt) - use swiftest_classes, only : swiftest_parameters, swiftest_nbody_system - implicit none - class(symba_tp), intent(inout) :: self !! SyMBA test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: dt !! Step size - end subroutine symba_gr_p4_tp - - module function symba_collision_casedisruption(system, param, colliders, frag) result(status) - use fraggle_classes, only : fraggle_colliders, fraggle_fragments - implicit none - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object - integer(I4B) :: status !! Status flag assigned to this outcome - end function symba_collision_casedisruption - - module function symba_collision_casehitandrun(system, param, colliders, frag) result(status) - use fraggle_classes, only : fraggle_colliders, fraggle_fragments - implicit none - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object - integer(I4B) :: status !! Status flag assigned to this outcome - end function symba_collision_casehitandrun - - module function symba_collision_casemerge(system, param, colliders, frag) result(status) - use fraggle_classes, only : fraggle_colliders, fraggle_fragments - implicit none - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object - integer(I4B) :: status !! Status flag assigned to this outcome - end function symba_collision_casemerge - - module subroutine symba_util_set_renc(self, scale) - implicit none - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - integer(I4B), intent(in) :: scale !! Current recursion depth - end subroutine symba_util_set_renc - - module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, iomsg) - implicit none - class(symba_parameters), intent(inout) :: self !! Current run configuration parameters with SyMBA additionss - integer, 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, intent(in) :: v_list(:) !! The first element passes the integrator code to the reader - integer, intent(out) :: iostat !! IO status code - character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 - end subroutine symba_io_param_reader - - module subroutine symba_io_param_writer(self, unit, iotype, v_list, iostat, iomsg) - implicit none - class(symba_parameters),intent(in) :: self !! Current run configuration parameters with SyMBA additions - integer, 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, intent(in) :: v_list(:) !! Not used in this procedure - integer, intent(out) :: iostat !! IO status code - character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 - end subroutine symba_io_param_writer - - module subroutine symba_io_write_discard(self, param) - use swiftest_classes, only : swiftest_parameters - implicit none - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine symba_io_write_discard - - module subroutine symba_kick_getacch_int_pl(self, param) - implicit none - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - end subroutine symba_kick_getacch_int_pl - - module subroutine symba_kick_getacch_pl(self, system, param, t, lbeg) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters - implicit none - class(symba_pl), intent(inout) :: self !! SyMBA massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: 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 !! Logical flag that determines whether or not this is the beginning or end of the step - end subroutine symba_kick_getacch_pl - - module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters - implicit none - class(symba_tp), intent(inout) :: self !! SyMBA test particle data structure - class(swiftest_nbody_system), intent(inout) :: 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 !! Logical flag that determines whether or not this is the beginning or end of the step - end subroutine symba_kick_getacch_tp - - module subroutine symba_kick_encounter(self, system, dt, irec, sgn) - implicit none - class(symba_encounter), intent(in) :: self !! SyMBA pl-tp encounter list object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - real(DP), intent(in) :: dt !! step size - integer(I4B), intent(in) :: irec !! Current recursion level - integer(I4B), intent(in) :: sgn !! sign to be applied to acceleration - end subroutine symba_kick_encounter - - module subroutine symba_setup_initialize_system(self, param) - use swiftest_classes, only : swiftest_parameters - implicit none - class(symba_nbody_system), intent(inout) :: self !! SyMBA system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine symba_setup_initialize_system - - module subroutine symba_setup_merger(self, n, param) - use swiftest_classes, only : swiftest_parameters - implicit none - class(symba_merger), intent(inout) :: self !! SyMBA merger list 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 symba_setup_merger - - module subroutine symba_setup_pl(self, n, param) - use swiftest_classes, only : swiftest_parameters - implicit none - 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 parameters - end subroutine symba_setup_pl - - module subroutine symba_setup_encounter_list(self,n) - implicit none - class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter structure - integer(I8B), intent(in) :: n !! Number of encounters to allocate space for - end subroutine symba_setup_encounter_list - - module subroutine symba_setup_tp(self, n, param) - use swiftest_classes, only : swiftest_parameters - implicit none - 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 - end subroutine symba_setup_tp - - module subroutine symba_step_system(self, param, t, dt) - use swiftest_classes, only : swiftest_parameters - implicit none - class(symba_nbody_system), intent(inout) :: self !! SyMBA 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 symba_step_system - - module subroutine symba_step_interp_system(self, param, t, dt) - use swiftest_classes, only : swiftest_parameters - implicit none - class(symba_nbody_system), intent(inout) :: self !! SyMBA 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 symba_step_interp_system - - module subroutine symba_step_set_recur_levels_system(self, ireci) - implicit none - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system objec - integer(I4B), intent(in) :: ireci !! Input recursion level - end subroutine symba_step_set_recur_levels_system - - recursive module subroutine symba_step_recur_system(self, param, t, ireci) - use swiftest_classes, only : swiftest_parameters - implicit none - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t - integer(I4B), intent(in) :: ireci !! input recursion level - end subroutine symba_step_recur_system - - module subroutine symba_step_reset_system(self, param) - implicit none - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(symba_parameters), intent(in) :: param !! Current run configuration parameters with SyMBA additions - end subroutine symba_step_reset_system - end interface - - interface util_append - module subroutine symba_util_append_arr_kin(arr, source, nold, nsrc, lsource_mask) - implicit none - type(symba_kinship), dimension(:), allocatable, intent(inout) :: arr !! Destination array - type(symba_kinship), dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - end subroutine symba_util_append_arr_kin - end interface - - interface - module subroutine symba_util_append_encounter_list(self, source, lsource_mask) - implicit none - class(symba_encounter), intent(inout) :: self !! SyMBA encounter list object - class(encounter_list), intent(in) :: source !! Source object to append - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - end subroutine symba_util_append_encounter_list - - module subroutine symba_util_append_merger(self, source, lsource_mask) - use swiftest_classes, only : swiftest_body - implicit none - class(symba_merger), 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 - end subroutine symba_util_append_merger - - module subroutine symba_util_append_pl(self, source, lsource_mask) - use swiftest_classes, only : swiftest_body - implicit none - 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 - end subroutine symba_util_append_pl - - module subroutine symba_util_append_tp(self, source, lsource_mask) - use swiftest_classes, only : swiftest_body - implicit none - 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 - end subroutine symba_util_append_tp - - module subroutine symba_util_copy_encounter_list(self, source) - use encounter_classes, only : encounter_list - implicit none - class(symba_encounter), intent(inout) :: self !! Encounter list - class(encounter_list), intent(in) :: source !! Source object to copy into - end subroutine symba_util_copy_encounter_list - - module subroutine symba_util_dealloc_encounter_list(self) - implicit none - class(symba_encounter), intent(inout) :: self !! SyMBA encounter list - end subroutine symba_util_dealloc_encounter_list - - module subroutine symba_util_dealloc_kin(self) - implicit none - class(symba_kinship), intent(inout) :: self !! SyMBA kinship object - end subroutine symba_util_dealloc_kin - - module subroutine symba_util_dealloc_merger(self) - implicit none - class(symba_merger), intent(inout) :: self !! SyMBA body merger object - end subroutine symba_util_dealloc_merger - - module subroutine symba_util_dealloc_system(self) - implicit none - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - end subroutine symba_util_dealloc_system - - module subroutine symba_util_dealloc_pl(self) - implicit none - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - end subroutine symba_util_dealloc_pl - - module subroutine symba_util_dealloc_tp(self) - implicit none - class(symba_tp), intent(inout) :: self !! SyMBA test particle object - end subroutine symba_util_dealloc_tp - end interface - - interface util_fill - module subroutine symba_util_fill_arr_kin(keeps, inserts, lfill_list) - implicit none - type(symba_kinship), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - type(symba_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 symba_util_fill_arr_kin - end interface - - interface - module subroutine symba_util_fill_pl(self, inserts, lfill_list) - use swiftest_classes, only : swiftest_body - implicit none - class(symba_pl), intent(inout) :: self !! SyMBA massive 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 - end subroutine symba_util_fill_pl - - module subroutine symba_util_fill_tp(self, inserts, lfill_list) - use swiftest_classes, only : swiftest_body - implicit none - 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 - end subroutine symba_util_fill_tp - - module subroutine symba_util_flatten_eucl_plpl(self, param) - use swiftest_classes, only : swiftest_parameters - implicit none - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine symba_util_flatten_eucl_plpl - - module subroutine symba_util_final_encounter_list(self) - implicit none - type(symba_encounter), intent(inout) :: self !! SyMBA encounter list object - end subroutine symba_util_final_encounter_list - - module subroutine symba_util_final_kin(self) - implicit none - type(symba_kinship), intent(inout) :: self !! SyMBA kinship object - end subroutine symba_util_final_kin - - module subroutine symba_util_final_merger(self) - implicit none - type(symba_merger), intent(inout) :: self !! SyMBA merger object - end subroutine symba_util_final_merger - - module subroutine symba_util_final_pl(self) - implicit none - type(symba_pl), intent(inout) :: self !! SyMBA massive body object - end subroutine symba_util_final_pl - - module subroutine symba_util_final_system(self) - implicit none - type(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - end subroutine symba_util_final_system - - module subroutine symba_util_final_tp(self) - implicit none - type(symba_tp), intent(inout) :: self !! SyMBA test particle object - end subroutine symba_util_final_tp - - module subroutine symba_util_peri_pl(self, system, param) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters - implicit none - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine symba_util_peri_pl - - module subroutine symba_util_rearray_pl(self, system, param) - implicit none - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - end subroutine symba_util_rearray_pl - - module subroutine symba_util_reset_kinship(self, idx) - implicit none - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - integer(I4B), dimension(:), intent(in) :: idx !! Index array of bodies to reset - end subroutine symba_util_reset_kinship - end interface - - interface util_resize - module subroutine symba_util_resize_arr_kin(arr, nnew) - implicit none - type(symba_kinship), dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size - end subroutine symba_util_resize_arr_kin - end interface - - interface - module subroutine symba_util_resize_merger(self, nnew) - implicit none - class(symba_merger), intent(inout) :: self !! SyMBA merger list object - integer(I4B), intent(in) :: nnew !! New size neded - end subroutine symba_util_resize_merger - - module subroutine symba_util_resize_pl(self, nnew) - implicit none - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - integer(I4B), intent(in) :: nnew !! New size neded - end subroutine symba_util_resize_pl - - module subroutine symba_util_resize_tp(self, nnew) - implicit none - class(symba_tp), intent(inout) :: self !! SyMBA massive body object - integer(I4B), intent(in) :: nnew !! New size neded - end subroutine symba_util_resize_tp - - module subroutine symba_util_sort_pl(self, sortby, ascending) - implicit none - 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 - end subroutine symba_util_sort_pl - - module subroutine symba_util_sort_tp(self, sortby, ascending) - implicit none - 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 - end subroutine symba_util_sort_tp - end interface - - interface util_sort_rearrange - module subroutine symba_util_sort_rearrange_arr_kin(arr, ind, n) - implicit none - type(symba_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 symba_util_sort_rearrange_arr_kin - end interface util_sort_rearrange - - interface - module subroutine symba_util_sort_rearrange_pl(self, ind) - implicit none - 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) - end subroutine symba_util_sort_rearrange_pl - - module subroutine symba_util_sort_rearrange_tp(self, ind) - implicit none - class(symba_tp), 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) - end subroutine symba_util_sort_rearrange_tp - end interface - - interface util_spill - module subroutine symba_util_spill_arr_kin(keeps, discards, lspill_list, ldestructive) - implicit none - type(symba_kinship), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - type(symba_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 symba_util_spill_arr_kin - end interface - - interface - module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive) - use swiftest_classes, only : swiftest_body - implicit none - 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 the keeps array or not - end subroutine symba_util_spill_pl - - module subroutine symba_util_spill_encounter_list(self, discards, lspill_list, ldestructive) - use encounter_classes, only : encounter_list - implicit none - class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list - class(encounter_list), 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 - end subroutine symba_util_spill_encounter_list - - module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) - use swiftest_classes, only : swiftest_body - implicit none - 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 the keeps array or not - end subroutine symba_util_spill_tp - end interface - -end module symba_classes \ No newline at end of file diff --git a/src/modules/walltime_classes.f90 b/src/modules/walltime_classes.f90 deleted file mode 100644 index 0dc3f2892..000000000 --- a/src/modules/walltime_classes.f90 +++ /dev/null @@ -1,131 +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. - -module walltime_classes - !! author: David A. Minton - !! - !! Classes and methods used to compute elasped wall time - use swiftest_globals - use swiftest_classes, only : swiftest_parameters, swiftest_pl - implicit none - public - - integer(I4B) :: INTERACTION_TIMER_CADENCE = 1000 !! Minimum number of steps to wait before timing an interaction loop in ADAPTIVE mode - character(len=*), parameter :: INTERACTION_TIMER_LOG_OUT = "interaction_timer.log" !! Name of log file for recording results of interaction loop timing - character(len=*), parameter :: ENCOUNTER_PLPL_TIMER_LOG_OUT = "encounter_check_plpl_timer.log" !! Name of log file for recording results of encounter check method timing - character(len=*), parameter :: ENCOUNTER_PLTP_TIMER_LOG_OUT = "encounter_check_pltp_timer.log" !! Name of log file for recording results of encounter check method timing - - type :: walltimer - integer(I8B) :: count_rate !! Rate at wich the clock ticks - integer(I8B) :: count_max !! Maximum value of the clock ticker - integer(I8B) :: count_start_main !! Value of the clock ticker at when the timer is first called - integer(I8B) :: count_start_step !! Value of the clock ticker at the start of a timed step - integer(I8B) :: count_stop_step !! Value of the clock ticker at the end of a timed step - integer(I8B) :: count_pause !! Value of the clock ticker at the end of a timed step - real(DP) :: wall_step !! Value of the step elapsed time - logical :: main_is_started = .false. !! Logical flag indicating whether or not the main timer has been reset or not - logical :: is_paused = .false. !! Logical flag indicating whether or not the timer is paused - - contains - procedure :: reset => walltime_reset !! Resets the clock ticker, settting main_start to the current ticker value - procedure :: start => walltime_start !! Starts or resumes the step timer - procedure :: start_main => walltime_start_main !! Starts the main timer - procedure :: stop => walltime_stop !! Pauses the step timer - procedure :: report => walltime_report !! Prints the elapsed time information to the terminal - end type walltimer - - type, extends(walltimer) :: interaction_timer - character(len=STRMAX) :: loopname !! Stores the name of the loop being timed for logging purposes - character(len=NAMELEN) :: looptype !! Stores the type of loop (e.g. INTERACTION or ENCOUNTER) - integer(I8B) :: max_interactions = huge(1_I8B) !! Stores the number of pl-pl interactions that failed when attempting to flatten (e.g. out of memory). Adapting won't occur if ninteractions > max_interactions - integer(I8B) :: last_interactions = 0 !! Number of interactions that were computed last time. The timer is only run if there has been a change to the number of interactions - integer(I4B) :: step_counter = 0 !! Number of steps that have elapsed since the last timed loop - logical :: is_on = .false. !! The loop timer is currently active - integer(I4B) :: stage = 1 !! The stage of the loop timing (1 or 2) - logical :: stage1_is_advanced !! Logical flag indicating whether stage1 was done with a flat loop (.true.) or triangular loop (.false.) - integer(I8B) :: stage1_ninteractions !! Number of interactions computed during stage 1 - real(DP) :: stage1_metric !! Metric used to judge the performance of a timed loop (e.g. (count_finish_step - count_start_step) / ninteractions) - real(DP) :: stage2_metric !! Metric used to judge the performance of a timed loop (e.g. (count_finish_step - count_start_step) / ninteractions) - contains - procedure :: adapt => walltime_interaction_adapt !! Runs the interaction loop adaptation algorithm on an interaction loop - procedure :: check => walltime_interaction_check !! Checks whether or not the loop should be timed and starts the timer if the conditions for starting are met - procedure :: flip => walltime_interaction_flip_loop_style !! Flips the interaction loop style from FLAT to TRIANGULAR or vice vers - procedure :: time_this_loop => walltime_interaction_time_this_loop !! Starts the interaction loop timer - end type interaction_timer - - interface - module subroutine walltime_report(self, message, nsubsteps) - implicit none - class(walltimer), intent(inout) :: self !! Walltimer object - character(len=*), intent(in) :: message !! Message to prepend to the wall time terminal output - integer(I4B), optional, intent(in) :: nsubsteps !! Number of substeps used to compute the time per step - end subroutine walltime_report - - module subroutine walltime_reset(self) - implicit none - class(walltimer), intent(inout) :: self !! Walltimer object - end subroutine walltime_reset - - module subroutine walltime_start(self) - implicit none - class(walltimer), intent(inout) :: self !! Walltimer object - end subroutine walltime_start - - module subroutine walltime_start_main(self) - implicit none - class(walltimer), intent(inout) :: self !! Walltimer object - end subroutine walltime_start_main - - module subroutine walltime_stop(self) - implicit none - class(walltimer), intent(inout) :: self !! Walltimer object - end subroutine walltime_stop - end interface - - interface - module subroutine walltime_interaction_adapt(self, param, ninteractions, pl) - use swiftest_classes, only : swiftest_parameters - implicit none - class(interaction_timer), intent(inout) :: self !! Interaction loop timer object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I8B), intent(in) :: ninteractions !! Current number of interactions (used to normalize the timed loop and to determine if number of interactions has changed since the last timing - class(swiftest_pl), intent(inout), optional :: pl !! Swiftest massive body object - end subroutine walltime_interaction_adapt - - module function walltime_interaction_check(self, param, ninteractions) result(ltimeit) - use swiftest_classes, only : swiftest_parameters - implicit none - class(interaction_timer), intent(inout) :: self !! Interaction loop timer object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I8B), intent(in) :: ninteractions !! Current number of interactions (used to normalize the timed loop and to determine if number of interactions has changed since the last timing - logical :: ltimeit !! Logical flag indicating whether this loop should be timed or not - end function walltime_interaction_check - - module subroutine walltime_interaction_flip_loop_style(self, param, pl) - use swiftest_classes, only : swiftest_parameters, swiftest_pl - implicit none - class(interaction_timer), intent(inout) :: self !! Interaction loop timer object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(swiftest_pl), intent(inout), optional :: pl !! Swiftest massive body object - end subroutine walltime_interaction_flip_loop_style - - module subroutine walltime_interaction_time_this_loop(self, param, ninteractions, pl) - use swiftest_classes, only : swiftest_parameters, swiftest_pl - implicit none - class(interaction_timer), intent(inout) :: self !! Interaction loop timer object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I8B), intent(in) :: ninteractions !! Current number of interactions (used to normalize the timed loop) - class(swiftest_pl), intent(inout), optional :: pl !! Swiftest massive body object - end subroutine walltime_interaction_time_this_loop - - end interface - - - -end module walltime_classes \ No newline at end of file diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 deleted file mode 100644 index 0cd27f737..000000000 --- a/src/netcdf/netcdf.f90 +++ /dev/null @@ -1,1241 +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. - -submodule (swiftest_classes) s_netcdf - use swiftest - use netcdf -contains - - subroutine check(status, call_identifier) - !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton - !! - !! Checks the status of all NetCDF operations to catch errors - implicit none - ! Arguments - 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 - - if(status /= nf90_noerr) then - if (present(call_identifier)) write(*,*) "NetCDF error in ",trim(call_identifier) - write(*,*) trim(nf90_strerror(status)) - call util_exit(FAILURE) - end if - - return - end subroutine check - - - module subroutine netcdf_close(self) - !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton - !! - !! Closes a NetCDF file - implicit none - ! Arguments - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - - call check( nf90_close(self%ncid), "netcdf_close" ) - - return - end subroutine netcdf_close - - - module subroutine netcdf_flush(self, param) - !! author: David A. Minton - !! - !! Flushes the current buffer to disk by closing and re-opening the file. - !! - implicit none - ! Arguments - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - - call self%close() - call self%open(param) - - return - end subroutine netcdf_flush - - - module function netcdf_get_old_t_final_system(self, param) result(old_t_final) - !! author: David A. Minton - !! - !! Validates the dump file to check whether the dump file initial conditions duplicate the last frame of the netcdf output. - !! - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self - class(swiftest_parameters), intent(inout) :: param - ! Result - real(DP) :: old_t_final - ! Internals - integer(I4B) :: itmax, idmax - real(DP), dimension(:), allocatable :: vals - real(DP), dimension(1) :: val - real(DP), dimension(NDIM) :: rot0, Ip0, Lnow - real(DP) :: KE_orb_orig, KE_spin_orig, PE_orig - - call param%nciu%open(param) - call check( nf90_inquire_dimension(param%nciu%ncid, param%nciu%time_dimid, len=itmax), "netcdf_get_old_t_final_system time_dimid" ) - call check( nf90_inquire_dimension(param%nciu%ncid, param%nciu%id_dimid, len=idmax), "netcdf_get_old_t_final_system id_dimid" ) - allocate(vals(idmax)) - call check( nf90_get_var(param%nciu%ncid, param%nciu%time_varid, val, start=[1], count=[1]), "netcdf_get_old_t_final_system time_varid" ) - - !old_t_final = val(1) - old_t_final = param%t0 ! For NetCDF it is safe to overwrite the final t value on a restart - - if (param%lenergy) then - call check( nf90_get_var(param%nciu%ncid, param%nciu%KE_orb_varid, val, start=[1], count=[1]), "netcdf_get_old_t_final_system KE_orb_varid" ) - KE_orb_orig = val(1) - - call check( nf90_get_var(param%nciu%ncid, param%nciu%KE_spin_varid, val, start=[1], count=[1]), "netcdf_get_old_t_final_system KE_spin_varid" ) - KE_spin_orig = val(1) - - call check( nf90_get_var(param%nciu%ncid, param%nciu%PE_varid, val, start=[1], count=[1]), "netcdf_get_old_t_final_system PE_varid" ) - PE_orig = val(1) - - call check( nf90_get_var(param%nciu%ncid, param%nciu%Ecollisions_varid, self%Ecollisions, start=[1]), "netcdf_get_old_t_final_system Ecollisions_varid" ) - call check( nf90_get_var(param%nciu%ncid, param%nciu%Euntracked_varid, self%Euntracked, start=[1]), "netcdf_get_old_t_final_system Euntracked_varid" ) - - self%Eorbit_orig = KE_orb_orig + KE_spin_orig + PE_orig + self%Ecollisions + self%Euntracked - - call check( nf90_get_var(param%nciu%ncid, param%nciu%L_orbx_varid, val, start=[1], count=[1]), "netcdf_get_old_t_final_system L_orbx_varid" ) - self%Lorbit_orig(1) = val(1) - call check( nf90_get_var(param%nciu%ncid, param%nciu%L_orby_varid, val, start=[1], count=[1]), "netcdf_get_old_t_final_system L_orby_varid" ) - self%Lorbit_orig(2) = val(1) - call check( nf90_get_var(param%nciu%ncid, param%nciu%L_orbz_varid, val, start=[1], count=[1]), "netcdf_get_old_t_final_system L_orbz_varid" ) - self%Lorbit_orig(3) = val(1) - - call check( nf90_get_var(param%nciu%ncid, param%nciu%L_spinx_varid, val, start=[1], count=[1]), "netcdf_get_old_t_final_system L_spinx_varid" ) - self%Lspin_orig(1) = val(1) - call check( nf90_get_var(param%nciu%ncid, param%nciu%L_spiny_varid, val, start=[1], count=[1]), "netcdf_get_old_t_final_system L_spiny_varid" ) - self%Lspin_orig(2) = val(1) - call check( nf90_get_var(param%nciu%ncid, param%nciu%L_spinz_varid, val, start=[1], count=[1]), "netcdf_get_old_t_final_system L_spinz_varid" ) - self%Lspin_orig(3) = val(1) - - call check( nf90_get_var(param%nciu%ncid, param%nciu%L_escapex_varid, self%Lescape(1), start=[1]), "netcdf_get_old_t_final_system L_escapex_varid" ) - call check( nf90_get_var(param%nciu%ncid, param%nciu%L_escapey_varid, self%Lescape(2), start=[1]), "netcdf_get_old_t_final_system L_escapey_varid" ) - call check( nf90_get_var(param%nciu%ncid, param%nciu%L_escapez_varid, self%Lescape(3), start=[1]), "netcdf_get_old_t_final_system L_escapez_varid" ) - - self%Ltot_orig(:) = self%Lorbit_orig(:) + self%Lspin_orig(:) + self%Lescape(:) - - call check( nf90_get_var(param%nciu%ncid, param%nciu%Gmass_varid, vals, start=[1,1], count=[idmax,1]), "netcdf_get_old_t_final_system Gmass_varid" ) - call check( nf90_get_var(param%nciu%ncid, param%nciu%GMescape_varid, self%GMescape, start=[1]), "netcdf_get_old_t_final_system GMescape_varid" ) - self%GMtot_orig = vals(1) + sum(vals(2:idmax), vals(2:idmax) == vals(2:idmax)) + self%GMescape - - select type(cb => self%cb) - class is (symba_cb) - cb%GM0 = vals(1) - cb%dGM = cb%Gmass - cb%GM0 - - call check( nf90_get_var(param%nciu%ncid, param%nciu%radius_varid, val, start=[1,1], count=[1,1]), "netcdf_get_old_t_final_system radius_varid" ) - cb%R0 = val(1) - - if (param%lrotation) then - - call check( nf90_get_var(param%nciu%ncid, param%nciu%rotx_varid, val, start=[1,1], count=[1,1]), "netcdf_get_old_t_final_system rotx_varid" ) - rot0(1) = val(1) - call check( nf90_get_var(param%nciu%ncid, param%nciu%roty_varid, val, start=[1,1], count=[1,1]), "netcdf_get_old_t_final_system roty_varid" ) - rot0(2) = val(1) - call check( nf90_get_var(param%nciu%ncid, param%nciu%rotz_varid, val, start=[1,1], count=[1,1]), "netcdf_get_old_t_final_system rotz_varid" ) - rot0(3) = val(1) - - call check( nf90_get_var(param%nciu%ncid, param%nciu%Ip1_varid, val, start=[1,1], count=[1,1]), "netcdf_get_old_t_final_system Ip1_varid" ) - Ip0(1) = val(1) - call check( nf90_get_var(param%nciu%ncid, param%nciu%Ip2_varid, val, start=[1,1], count=[1,1]), "netcdf_get_old_t_final_system Ip2_varid" ) - Ip0(2) = val(1) - call check( nf90_get_var(param%nciu%ncid, param%nciu%Ip3_varid, val, start=[1,1], count=[1,1]), "netcdf_get_old_t_final_system Ip3_varid" ) - Ip0(3) = val(1) - - cb%L0(:) = Ip0(3) * cb%GM0 * cb%R0**2 * rot0(:) - - Lnow(:) = cb%Ip(3) * cb%Gmass * cb%radius**2 * cb%rot(:) - cb%dL(:) = Lnow(:) - cb%L0(:) - end if - end select - - end if - - deallocate(vals) - - return - end function netcdf_get_old_t_final_system - - - module subroutine netcdf_initialize_output(self, param) - !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton - !! - !! Initialize a NetCDF file system and defines all variables. - use, intrinsic :: ieee_arithmetic - implicit none - ! Arguments - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: nvar, varid, vartype - real(DP) :: dfill - real(SP) :: sfill - logical :: fileExists - character(len=STRMAX) :: errmsg - integer(I4B) :: ndims - - dfill = ieee_value(dfill, IEEE_QUIET_NAN) - sfill = ieee_value(sfill, IEEE_QUIET_NAN) - - ! Check if the file exists, and if it does, delete it - inquire(file=param%outfile, exist=fileExists) - if (fileExists) then - open(unit=LUN, file=param%outfile, status="old", err=667, iomsg=errmsg) - close(unit=LUN, status="delete") - end if - - call check( nf90_create(param%outfile, NF90_NETCDF4, self%ncid), "netcdf_initialize_output nf90_create" ) - - ! Define the NetCDF dimensions with particle name as the record dimension - call check( nf90_def_dim(self%ncid, ID_DIMNAME, NF90_UNLIMITED, self%id_dimid), "netcdf_initialize_output nf90_def_dim id_dimid" ) ! 'x' dimension - call check( nf90_def_dim(self%ncid, TIME_DIMNAME, NF90_UNLIMITED, self%time_dimid), "netcdf_initialize_output nf90_def_dim time_dimid" ) ! 'y' dimension - call check( nf90_def_dim(self%ncid, STR_DIMNAME, NAMELEN, self%str_dimid), "netcdf_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - - select case (param%out_type) - case(NETCDF_FLOAT_TYPE) - self%out_type = NF90_FLOAT - case(NETCDF_DOUBLE_TYPE) - self%out_type = NF90_DOUBLE - end select - - !! Define the variables - call check( nf90_def_var(self%ncid, TIME_DIMNAME, self%out_type, self%time_dimid, self%time_varid), "netcdf_initialize_output nf90_def_var time_varid" ) - call check( nf90_def_var(self%ncid, ID_DIMNAME, NF90_INT, self%id_dimid, self%id_varid), "netcdf_initialize_output nf90_def_var id_varid" ) - call check( nf90_def_var(self%ncid, NPL_VARNAME, NF90_INT, self%time_dimid, self%npl_varid), "netcdf_initialize_output nf90_def_var npl_varid" ) - call check( nf90_def_var(self%ncid, NTP_VARNAME, NF90_INT, self%time_dimid, self%ntp_varid), "netcdf_initialize_output nf90_def_var ntp_varid" ) - if (param%integrator == SYMBA) call check( nf90_def_var(self%ncid, NPLM_VARNAME, NF90_INT, self%time_dimid, self%nplm_varid), "netcdf_initialize_output nf90_def_var nplm_varid" ) - call check( nf90_def_var(self%ncid, NAME_VARNAME, NF90_CHAR, [self%str_dimid, self%id_dimid], self%name_varid), "netcdf_initialize_output nf90_def_var name_varid" ) - call check( nf90_def_var(self%ncid, PTYPE_VARNAME, NF90_CHAR, [self%str_dimid, self%id_dimid], self%ptype_varid), "netcdf_initialize_output nf90_def_var ptype_varid" ) - call check( nf90_def_var(self%ncid, STATUS_VARNAME, NF90_CHAR, [self%str_dimid, self%id_dimid], self%status_varid), "netcdf_initialize_output nf90_def_var status_varid" ) - - if ((param%out_form == XV) .or. (param%out_form == XVEL)) then - call check( nf90_def_var(self%ncid, XHX_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%xhx_varid), "netcdf_initialize_output nf90_def_var xhx_varid" ) - call check( nf90_def_var(self%ncid, XHY_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%xhy_varid), "netcdf_initialize_output nf90_def_var xhy_varid" ) - call check( nf90_def_var(self%ncid, XHZ_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%xhz_varid), "netcdf_initialize_output nf90_def_var xhz_varid" ) - call check( nf90_def_var(self%ncid, VHX_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%vhx_varid), "netcdf_initialize_output nf90_def_var vhx_varid" ) - call check( nf90_def_var(self%ncid, VHY_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%vhy_varid), "netcdf_initialize_output nf90_def_var vhy_varid" ) - call check( nf90_def_var(self%ncid, VHZ_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%vhz_varid), "netcdf_initialize_output nf90_def_var vhz_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 during the conversion. - if (param%lgr) then - call check( nf90_def_var(self%ncid, GR_PSEUDO_VHX_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%gr_pseudo_vhx_varid), "netcdf_initialize_output nf90_def_var gr_psuedo_vhx_varid" ) - call check( nf90_def_var(self%ncid, GR_PSEUDO_VHY_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%gr_pseudo_vhy_varid), "netcdf_initialize_output nf90_def_var gr_psuedo_vhy_varid" ) - call check( nf90_def_var(self%ncid, GR_PSEUDO_VHZ_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%gr_pseudo_vhz_varid), "netcdf_initialize_output nf90_def_var gr_psuedo_vhz_varid" ) - self%lpseudo_vel_exists = .true. - end if - - end if - - if ((param%out_form == EL) .or. (param%out_form == XVEL)) then - call check( nf90_def_var(self%ncid, A_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%a_varid), "netcdf_initialize_output nf90_def_var a_varid" ) - call check( nf90_def_var(self%ncid, E_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%e_varid), "netcdf_initialize_output nf90_def_var e_varid" ) - call check( nf90_def_var(self%ncid, INC_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%inc_varid), "netcdf_initialize_output nf90_def_var inc_varid" ) - call check( nf90_def_var(self%ncid, CAPOM_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%capom_varid), "netcdf_initialize_output nf90_def_var capom_varid" ) - call check( nf90_def_var(self%ncid, OMEGA_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%omega_varid), "netcdf_initialize_output nf90_def_var omega_varid" ) - call check( nf90_def_var(self%ncid, CAPM_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%capm_varid), "netcdf_initialize_output nf90_def_var capm_varid" ) - end if - - call check( nf90_def_var(self%ncid, GMASS_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%Gmass_varid), "netcdf_initialize_output nf90_def_var Gmass_varid" ) - - if (param%lrhill_present) then - call check( nf90_def_var(self%ncid, RHILL_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%rhill_varid), "netcdf_initialize_output nf90_def_var rhill_varid" ) - end if - - if (param%lclose) then - call check( nf90_def_var(self%ncid, RADIUS_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%radius_varid), "netcdf_initialize_output nf90_def_var radius_varid" ) - - call check( nf90_def_var(self%ncid, ORIGIN_TIME_VARNAME, self%out_type, self%id_dimid, self%origin_time_varid), "netcdf_initialize_output nf90_def_var origin_time_varid" ) - call check( nf90_def_var(self%ncid, ORIGIN_TYPE_VARNAME, NF90_CHAR, [self%str_dimid, self%id_dimid], & - self%origin_type_varid), "netcdf_initialize_output nf90_create" ) - call check( nf90_def_var(self%ncid, ORIGIN_XHX_VARNAME, self%out_type, self%id_dimid, self%origin_xhx_varid), "netcdf_initialize_output nf90_def_var origin_xhx_varid" ) - call check( nf90_def_var(self%ncid, ORIGIN_XHY_VARNAME, self%out_type, self%id_dimid, self%origin_xhy_varid), "netcdf_initialize_output nf90_def_var origin_xhy_varid" ) - call check( nf90_def_var(self%ncid, ORIGIN_XHZ_VARNAME, self%out_type, self%id_dimid, self%origin_xhz_varid), "netcdf_initialize_output nf90_def_var origin_xhz_varid" ) - call check( nf90_def_var(self%ncid, ORIGIN_VHX_VARNAME, self%out_type, self%id_dimid, self%origin_vhx_varid), "netcdf_initialize_output nf90_def_var origin_vhx_varid" ) - call check( nf90_def_var(self%ncid, ORIGIN_VHY_VARNAME, self%out_type, self%id_dimid, self%origin_vhy_varid), "netcdf_initialize_output nf90_def_var origin_vhy_varid" ) - call check( nf90_def_var(self%ncid, ORIGIN_VHZ_VARNAME, self%out_type, self%id_dimid, self%origin_vhz_varid), "netcdf_initialize_output nf90_def_var origin_vhz_varid" ) - - call check( nf90_def_var(self%ncid, COLLISION_ID_VARNAME, NF90_INT, self%id_dimid, self%collision_id_varid), "netcdf_initialize_output nf90_def_var collision_id_varid" ) - call check( nf90_def_var(self%ncid, DISCARD_TIME_VARNAME, self%out_type, self%id_dimid, self%discard_time_varid), "netcdf_initialize_output nf90_def_var discard_time_varid" ) - call check( nf90_def_var(self%ncid, DISCARD_XHX_VARNAME, self%out_type, self%id_dimid, self%discard_xhx_varid), "netcdf_initialize_output nf90_def_var discard_xhx_varid" ) - call check( nf90_def_var(self%ncid, DISCARD_XHY_VARNAME, self%out_type, self%id_dimid, self%discard_xhy_varid), "netcdf_initialize_output nf90_def_var discard_xhy_varid" ) - call check( nf90_def_var(self%ncid, DISCARD_XHZ_VARNAME, self%out_type, self%id_dimid, self%discard_xhz_varid), "netcdf_initialize_output nf90_def_var discard_xhz_varid" ) - call check( nf90_def_var(self%ncid, DISCARD_VHX_VARNAME, self%out_type, self%id_dimid, self%discard_vhx_varid), "netcdf_initialize_output nf90_def_var discard_vhx_varid" ) - call check( nf90_def_var(self%ncid, DISCARD_VHY_VARNAME, self%out_type, self%id_dimid, self%discard_vhy_varid), "netcdf_initialize_output nf90_def_var discard_vhy_varid" ) - call check( nf90_def_var(self%ncid, DISCARD_VHZ_VARNAME, self%out_type, self%id_dimid, self%discard_vhz_varid), "netcdf_initialize_output nf90_def_var discard_vhz_varid" ) - call check( nf90_def_var(self%ncid, DISCARD_BODY_ID_VARNAME, NF90_INT, self%id_dimid, self%discard_body_id_varid), "netcdf_initialize_output nf90_def_var discard_body_id_varid" ) - end if - - if (param%lrotation) then - call check( nf90_def_var(self%ncid, IP1_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%Ip1_varid), "netcdf_initialize_output nf90_def_var Ip1_varid" ) - call check( nf90_def_var(self%ncid, IP2_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%Ip2_varid), "netcdf_initialize_output nf90_def_var Ip2_varid" ) - call check( nf90_def_var(self%ncid, IP3_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%Ip3_varid), "netcdf_initialize_output nf90_def_var Ip3_varid" ) - call check( nf90_def_var(self%ncid, ROTX_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%rotx_varid), "netcdf_initialize_output nf90_def_var rotx_varid" ) - call check( nf90_def_var(self%ncid, ROTY_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%roty_varid), "netcdf_initialize_output nf90_def_var roty_varid" ) - call check( nf90_def_var(self%ncid, ROTZ_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%rotz_varid), "netcdf_initialize_output nf90_def_var rotz_varid" ) - end if - - ! if (param%ltides) then - ! call check( nf90_def_var(self%ncid, K2_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%k2_varid), "netcdf_initialize_output nf90_def_var k2_varid" ) - ! call check( nf90_def_var(self%ncid, Q_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%Q_varid), "netcdf_initialize_output nf90_def_var Q_varid" ) - ! end if - - if (param%lenergy) then - call check( nf90_def_var(self%ncid, KE_ORB_VARNAME, self%out_type, self%time_dimid, self%KE_orb_varid), "netcdf_initialize_output nf90_def_var KE_orb_varid" ) - call check( nf90_def_var(self%ncid, KE_SPIN_VARNAME, self%out_type, self%time_dimid, self%KE_spin_varid), "netcdf_initialize_output nf90_def_var KE_spin_varid" ) - call check( nf90_def_var(self%ncid, PE_VARNAME, self%out_type, self%time_dimid, self%PE_varid), "netcdf_initialize_output nf90_def_var PE_varid" ) - call check( nf90_def_var(self%ncid, L_ORBX_VARNAME, self%out_type, self%time_dimid, self%L_orbx_varid), "netcdf_initialize_output nf90_def_var L_orbx_varid" ) - call check( nf90_def_var(self%ncid, L_ORBY_VARNAME, self%out_type, self%time_dimid, self%L_orby_varid), "netcdf_initialize_output nf90_def_var L_orby_varid" ) - call check( nf90_def_var(self%ncid, L_ORBZ_VARNAME, self%out_type, self%time_dimid, self%L_orbz_varid), "netcdf_initialize_output nf90_def_var L_orbz_varid" ) - call check( nf90_def_var(self%ncid, L_SPINX_VARNAME, self%out_type, self%time_dimid, self%L_spinx_varid), "netcdf_initialize_output nf90_def_var L_spinx_varid" ) - call check( nf90_def_var(self%ncid, L_SPINY_VARNAME, self%out_type, self%time_dimid, self%L_spiny_varid), "netcdf_initialize_output nf90_def_var L_spiny_varid" ) - call check( nf90_def_var(self%ncid, L_SPINZ_VARNAME, self%out_type, self%time_dimid, self%L_spinz_varid), "netcdf_initialize_output nf90_def_var L_spinz_varid" ) - call check( nf90_def_var(self%ncid, L_ESCAPEX_VARNAME, self%out_type, self%time_dimid, self%L_escapex_varid), "netcdf_initialize_output nf90_def_var L_escapex_varid" ) - call check( nf90_def_var(self%ncid, L_ESCAPEY_VARNAME, self%out_type, self%time_dimid, self%L_escapey_varid), "netcdf_initialize_output nf90_def_var L_escapey_varid" ) - call check( nf90_def_var(self%ncid, L_ESCAPEZ_VARNAME, self%out_type, self%time_dimid, self%L_escapez_varid), "netcdf_initialize_output nf90_def_var L_escapez_varid" ) - call check( nf90_def_var(self%ncid, ECOLLISIONS_VARNAME, self%out_type, self%time_dimid, self%Ecollisions_varid), "netcdf_initialize_output nf90_def_var Ecollisions_varid" ) - call check( nf90_def_var(self%ncid, EUNTRACKED_VARNAME, self%out_type, self%time_dimid, self%Euntracked_varid), "netcdf_initialize_output nf90_def_var Euntracked_varid" ) - call check( nf90_def_var(self%ncid, GMESCAPE_VARNAME, self%out_type, self%time_dimid, self%GMescape_varid), "netcdf_initialize_output nf90_def_var GMescape_varid" ) - end if - - call check( nf90_def_var(self%ncid, J2RP2_VARNAME, self%out_type, self%time_dimid, self%j2rp2_varid), "netcdf_initialize_output nf90_def_var j2rp2_varid" ) - call check( nf90_def_var(self%ncid, J4RP4_VARNAME, self%out_type, self%time_dimid, self%j4rp4_varid), "netcdf_initialize_output nf90_def_var j4rp4_varid" ) - - - ! Set fill mode to NaN for all variables - call check( nf90_inquire(self%ncid, nVariables=nvar), "netcdf_initialize_output nf90_inquire nVariables" ) - do varid = 1, nvar - call check( nf90_inquire_variable(self%ncid, varid, xtype=vartype, ndims=ndims), "netcdf_initialize_output nf90_inquire_variable" ) - select case(vartype) - case(NF90_INT) - call check( nf90_def_var_fill(self%ncid, varid, 0, NF90_FILL_INT), "netcdf_initialize_output nf90_def_var_fill NF90_INT" ) - case(NF90_FLOAT) - call check( nf90_def_var_fill(self%ncid, varid, 0, sfill), "netcdf_initialize_output nf90_def_var_fill NF90_FLOAT" ) - case(NF90_DOUBLE) - call check( nf90_def_var_fill(self%ncid, varid, 0, dfill), "netcdf_initialize_output nf90_def_var_fill NF90_DOUBLE" ) - case(NF90_CHAR) - call check( nf90_def_var_fill(self%ncid, varid, 0, 0), "netcdf_initialize_output nf90_def_var_fill NF90_CHAR" ) - end select - end do - - ! Take the file out of define mode - call check( nf90_enddef(self%ncid), "netcdf_initialize_output nf90_enddef" ) - - return - - 667 continue - write(*,*) "Error creating NetCDF output file. " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine netcdf_initialize_output - - - module subroutine netcdf_open(self, param, readonly) - !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton - !! - !! Opens a NetCDF file and does the variable inquiries to activate variable ids - implicit none - ! Arguments - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - logical, optional, intent(in) :: readonly !! Logical flag indicating that this should be open read only - ! Internals - integer(I4B) :: mode, status - character(len=NF90_MAX_NAME) :: str_dim_name - - mode = NF90_WRITE - if (present(readonly)) then - if (readonly) mode = NF90_NOWRITE - end if - - call check( nf90_open(param%outfile, mode, self%ncid), "netcdf_open nf90_open" ) - - call check( nf90_inq_dimid(self%ncid, TIME_DIMNAME, self%time_dimid), "netcdf_open nf90_inq_dimid time_dimid" ) - call check( nf90_inq_dimid(self%ncid, ID_DIMNAME, self%id_dimid), "netcdf_open nf90_inq_dimid id_dimid" ) - call check( nf90_inquire_dimension(self%ncid, max(self%time_dimid,self%id_dimid)+1, name=str_dim_name), "netcdf_open nf90_inquire_dimension str_dim_name" ) - call check( nf90_inq_dimid(self%ncid, str_dim_name, self%str_dimid), "netcdf_open nf90_inq_dimid str_dimid" ) - - call check( nf90_inq_varid(self%ncid, TIME_DIMNAME, self%time_varid), "netcdf_open nf90_inq_varid time_varid" ) - call check( nf90_inq_varid(self%ncid, ID_DIMNAME, self%id_varid), "netcdf_open nf90_inq_varid id_varid" ) - call check( nf90_inq_varid(self%ncid, NPL_VARNAME, self%npl_varid), "netcdf_open nf90_inq_varid npl_varid" ) - call check( nf90_inq_varid(self%ncid, NTP_VARNAME, self%ntp_varid), "netcdf_open nf90_inq_varid ntp_varid" ) - if (param%integrator == SYMBA) call check( nf90_inq_varid(self%ncid, NPLM_VARNAME, self%nplm_varid), "netcdf_open nf90_inq_varid nplm_varid" ) - call check( nf90_inq_varid(self%ncid, NAME_VARNAME, self%name_varid), "netcdf_open nf90_inq_varid name_varid" ) - call check( nf90_inq_varid(self%ncid, PTYPE_VARNAME, self%ptype_varid), "netcdf_open nf90_inq_varid ptype_varid" ) - call check( nf90_inq_varid(self%ncid, STATUS_VARNAME, self%status_varid), "netcdf_open nf90_inq_varid status_varid" ) - - if ((param%out_form == XV) .or. (param%out_form == XVEL)) then - call check( nf90_inq_varid(self%ncid, XHX_VARNAME, self%xhx_varid), "netcdf_open nf90_inq_varid xhx_varid" ) - call check( nf90_inq_varid(self%ncid, XHY_VARNAME, self%xhy_varid), "netcdf_open nf90_inq_varid xhy_varid" ) - call check( nf90_inq_varid(self%ncid, XHZ_VARNAME, self%xhz_varid), "netcdf_open nf90_inq_varid xhz_varid" ) - call check( nf90_inq_varid(self%ncid, VHX_VARNAME, self%vhx_varid), "netcdf_open nf90_inq_varid vhx_varid" ) - call check( nf90_inq_varid(self%ncid, VHY_VARNAME, self%vhy_varid), "netcdf_open nf90_inq_varid vhy_varid" ) - call check( nf90_inq_varid(self%ncid, VHZ_VARNAME, self%vhz_varid), "netcdf_open nf90_inq_varid vhz_varid" ) - - if (param%lgr) then - !! check if pseudovelocity vectors exist in this file. If they are, set the correct flag so we know whe should not do the conversion. - status = nf90_inq_varid(self%ncid, GR_PSEUDO_VHX_VARNAME, self%gr_pseudo_vhx_varid) - self%lpseudo_vel_exists = (status == nf90_noerr) - if (self%lpseudo_vel_exists) then - status = nf90_inq_varid(self%ncid, GR_PSEUDO_VHY_VARNAME, self%gr_pseudo_vhy_varid) - self%lpseudo_vel_exists = (status == nf90_noerr) - if (self%lpseudo_vel_exists) then - status = nf90_inq_varid(self%ncid, GR_PSEUDO_VHZ_VARNAME, self%gr_pseudo_vhz_varid) - self%lpseudo_vel_exists = (status == nf90_noerr) - end if - end if - if (.not.self%lpseudo_vel_exists) then - write(*,*) "Warning! Pseudovelocity not found in input file for GR enabled run. If this is a restarted run, bit-identical trajectories are not guarunteed!" - end if - - end if - - end if - - if ((param%out_form == EL) .or. (param%out_form == XVEL)) then - call check( nf90_inq_varid(self%ncid, A_VARNAME, self%a_varid), "netcdf_open nf90_inq_varid a_varid" ) - call check( nf90_inq_varid(self%ncid, E_VARNAME, self%e_varid), "netcdf_open nf90_inq_varid e_varid" ) - call check( nf90_inq_varid(self%ncid, INC_VARNAME, self%inc_varid), "netcdf_open nf90_inq_varid inc_varid" ) - call check( nf90_inq_varid(self%ncid, CAPOM_VARNAME, self%capom_varid), "netcdf_open nf90_inq_varid capom_varid" ) - call check( nf90_inq_varid(self%ncid, OMEGA_VARNAME, self%omega_varid), "netcdf_open nf90_inq_varid omega_varid" ) - call check( nf90_inq_varid(self%ncid, CAPM_VARNAME, self%capm_varid), "netcdf_open nf90_inq_varid capm_varid" ) - end if - call check( nf90_inq_varid(self%ncid, GMASS_VARNAME, self%Gmass_varid), "netcdf_open nf90_inq_varid Gmass_varid" ) - - if (param%lrhill_present) call check( nf90_inq_varid(self%ncid, RHILL_VARNAME, self%rhill_varid), "netcdf_open nf90_inq_varid rhill_varid" ) - - if (param%lclose) then - call check( nf90_inq_varid(self%ncid, RADIUS_VARNAME, self%radius_varid), "netcdf_open nf90_inq_varid radius_varid" ) - call check( nf90_inq_varid(self%ncid, ORIGIN_TYPE_VARNAME, self%origin_type_varid), "netcdf_open nf90_inq_varid origin_type_varid" ) - call check( nf90_inq_varid(self%ncid, ORIGIN_TIME_VARNAME, self%origin_time_varid), "netcdf_open nf90_inq_varid origin_time_varid" ) - call check( nf90_inq_varid(self%ncid, ORIGIN_XHX_VARNAME, self%origin_xhx_varid), "netcdf_open nf90_inq_varid origin_xhx_varid" ) - call check( nf90_inq_varid(self%ncid, ORIGIN_XHY_VARNAME, self%origin_xhy_varid), "netcdf_open nf90_inq_varid origin_xhy_varid" ) - call check( nf90_inq_varid(self%ncid, ORIGIN_XHZ_VARNAME, self%origin_xhz_varid), "netcdf_open nf90_inq_varid origin_xhz_varid" ) - call check( nf90_inq_varid(self%ncid, ORIGIN_VHX_VARNAME, self%origin_vhx_varid), "netcdf_open nf90_inq_varid origin_vhx_varid" ) - call check( nf90_inq_varid(self%ncid, ORIGIN_VHY_VARNAME, self%origin_vhy_varid), "netcdf_open nf90_inq_varid origin_vhy_varid" ) - call check( nf90_inq_varid(self%ncid, ORIGIN_VHZ_VARNAME, self%origin_vhz_varid), "netcdf_open nf90_inq_varid origin_vhz_varid" ) - - call check( nf90_inq_varid(self%ncid, COLLISION_ID_VARNAME, self%collision_id_varid), "netcdf_open nf90_inq_varid collision_id_varid" ) - call check( nf90_inq_varid(self%ncid, DISCARD_TIME_VARNAME, self%discard_time_varid), "netcdf_open nf90_inq_varid discard_time_varid" ) - call check( nf90_inq_varid(self%ncid, DISCARD_XHX_VARNAME, self%discard_xhx_varid), "netcdf_open nf90_inq_varid discard_xhx_varid" ) - call check( nf90_inq_varid(self%ncid, DISCARD_XHY_VARNAME, self%discard_xhy_varid), "netcdf_open nf90_inq_varid discard_xhy_varid" ) - call check( nf90_inq_varid(self%ncid, DISCARD_XHZ_VARNAME, self%discard_xhz_varid), "netcdf_open nf90_inq_varid discard_xhz_varid" ) - call check( nf90_inq_varid(self%ncid, DISCARD_VHX_VARNAME, self%discard_vhx_varid), "netcdf_open nf90_inq_varid discard_vhx_varid" ) - call check( nf90_inq_varid(self%ncid, DISCARD_VHY_VARNAME, self%discard_vhy_varid), "netcdf_open nf90_inq_varid discard_vhy_varid" ) - call check( nf90_inq_varid(self%ncid, DISCARD_VHZ_VARNAME, self%discard_vhz_varid), "netcdf_open nf90_inq_varid discard_vhz_varid" ) - call check( nf90_inq_varid(self%ncid, DISCARD_BODY_ID_VARNAME, self%discard_body_id_varid), "netcdf_open nf90_inq_varid discard_body_id_varid" ) - end if - - if (param%lrotation) then - call check( nf90_inq_varid(self%ncid, IP1_VARNAME, self%Ip1_varid), "netcdf_open nf90_inq_varid Ip1_varid" ) - call check( nf90_inq_varid(self%ncid, IP2_VARNAME, self%Ip2_varid), "netcdf_open nf90_inq_varid Ip2_varid" ) - call check( nf90_inq_varid(self%ncid, IP3_VARNAME, self%Ip3_varid), "netcdf_open nf90_inq_varid Ip3_varid" ) - call check( nf90_inq_varid(self%ncid, ROTX_VARNAME, self%rotx_varid), "netcdf_open nf90_inq_varid rotx_varid" ) - call check( nf90_inq_varid(self%ncid, ROTY_VARNAME, self%roty_varid), "netcdf_open nf90_inq_varid roty_varid" ) - call check( nf90_inq_varid(self%ncid, ROTZ_VARNAME, self%rotz_varid), "netcdf_open nf90_inq_varid rotz_varid" ) - end if - - ! if (param%ltides) then - ! call check( nf90_inq_varid(self%ncid, K2_VARNAME, self%k2_varid), "netcdf_open nf90_inq_varid k2_varid" ) - ! call check( nf90_inq_varid(self%ncid, Q_VARNAME, self%Q_varid), "netcdf_open nf90_inq_varid Q_varid" ) - ! end if - - if (param%lenergy) then - call check( nf90_inq_varid(self%ncid, KE_ORB_VARNAME, self%KE_orb_varid), "netcdf_open nf90_inq_varid KE_orb_varid" ) - call check( nf90_inq_varid(self%ncid, KE_SPIN_VARNAME, self%KE_spin_varid), "netcdf_open nf90_inq_varid KE_spin_varid" ) - call check( nf90_inq_varid(self%ncid, PE_VARNAME, self%PE_varid), "netcdf_open nf90_inq_varid PE_varid" ) - call check( nf90_inq_varid(self%ncid, L_ORBX_VARNAME, self%L_orbx_varid), "netcdf_open nf90_inq_varid L_orbx_varid" ) - call check( nf90_inq_varid(self%ncid, L_ORBY_VARNAME, self%L_orby_varid), "netcdf_open nf90_inq_varid L_orby_varid" ) - call check( nf90_inq_varid(self%ncid, L_ORBZ_VARNAME, self%L_orbz_varid), "netcdf_open nf90_inq_varid L_orbz_varid" ) - call check( nf90_inq_varid(self%ncid, L_SPINX_VARNAME, self%L_spinx_varid), "netcdf_open nf90_inq_varid L_spinx_varid" ) - call check( nf90_inq_varid(self%ncid, L_SPINY_VARNAME, self%L_spiny_varid), "netcdf_open nf90_inq_varid L_spiny_varid" ) - call check( nf90_inq_varid(self%ncid, L_SPINZ_VARNAME, self%L_spinz_varid), "netcdf_open nf90_inq_varid L_spinz_varid" ) - call check( nf90_inq_varid(self%ncid, L_ESCAPEX_VARNAME, self%L_escapex_varid), "netcdf_open nf90_inq_varid L_escapex_varid" ) - call check( nf90_inq_varid(self%ncid, L_ESCAPEY_VARNAME, self%L_escapey_varid), "netcdf_open nf90_inq_varid L_escapey_varid" ) - call check( nf90_inq_varid(self%ncid, L_ESCAPEZ_VARNAME, self%L_escapez_varid), "netcdf_open nf90_inq_varid L_escapez_varid" ) - call check( nf90_inq_varid(self%ncid, ECOLLISIONS_VARNAME, self%Ecollisions_varid), "netcdf_open nf90_inq_varid Ecollisions_varid" ) - call check( nf90_inq_varid(self%ncid, EUNTRACKED_VARNAME, self%Euntracked_varid), "netcdf_open nf90_inq_varid Euntracked_varid" ) - call check( nf90_inq_varid(self%ncid, GMESCAPE_VARNAME, self%GMescape_varid), "netcdf_open nf90_inq_varid GMescape_varid" ) - end if - - call check( nf90_inq_varid(self%ncid, J2RP2_VARNAME, self%j2rp2_varid), "netcdf_open nf90_inq_varid j2rp2_varid" ) - call check( nf90_inq_varid(self%ncid, J4RP4_VARNAME, self%j4rp4_varid), "netcdf_open nf90_inq_varid j4rp4_varid" ) - - - return - end subroutine netcdf_open - - - module function netcdf_read_frame_system(self, iu, param) result(ierr) - !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Read a frame (header plus records for each massive body and active test particle) from an output binary file - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(netcdf_parameters), intent(inout) :: iu !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Return - integer(I4B) :: ierr !! Error code: returns 0 if the read is successful - ! Internals - integer(I4B) :: tslot, idmax, npl_check, ntp_check, nplm_check, t_max, str_max - real(DP), dimension(:), allocatable :: rtemp - integer(I4B), dimension(:), allocatable :: itemp - logical, dimension(:), allocatable :: validmask, tpmask, plmask - - call iu%open(param, readonly=.true.) - call self%read_hdr(iu, param) - - associate(cb => self%cb, pl => self%pl, tp => self%tp, npl => self%pl%nbody, ntp => self%tp%nbody) - - call pl%setup(npl, param) - call tp%setup(ntp, param) - - tslot = int(param%ioutput, kind=I4B) + 1 - - call check( nf90_inquire_dimension(iu%ncid, iu%id_dimid, len=idmax), "netcdf_read_frame_system nf90_inquire_dimension id_dimid" ) - allocate(rtemp(idmax)) - allocate(itemp(idmax)) - allocate(validmask(idmax)) - allocate(tpmask(idmax)) - allocate(plmask(idmax)) - call check( nf90_inquire_dimension(iu%ncid, iu%time_dimid, len=t_max), "netcdf_read_frame_system nf90_inquire_dimension time_dimid" ) - call check( nf90_inquire_dimension(iu%ncid, iu%str_dimid, len=str_max), "netcdf_read_frame_system nf90_inquire_dimension str_dimid" ) - - ! First filter out only the id slots that contain valid bodies - if (param%in_form == XV) then - call check( nf90_get_var(iu%ncid, iu%xhx_varid, rtemp(:), start=[1, tslot]), "netcdf_read_frame_system filter pass nf90_getvar xhx_varid" ) - else - call check( nf90_get_var(iu%ncid, iu%a_varid, rtemp(:), start=[1, tslot]), "netcdf_read_frame_system filter pass nf90_getvar a_varid" ) - end if - - validmask(:) = rtemp(:) == rtemp(:) - - ! Next, filter only bodies that don't have mass (test particles) - call check( nf90_get_var(iu%ncid, iu%Gmass_varid, rtemp(:), start=[1, tslot]), "netcdf_read_frame_system nf90_getvar Gmass_varid" ) - plmask(:) = rtemp(:) == rtemp(:) .and. validmask(:) - tpmask(:) = .not. plmask(:) .and. validmask(:) - plmask(1) = .false. ! This is the central body - - ! Check to make sure the number of bodies is correct - npl_check = count(plmask(:)) - ntp_check = count(tpmask(:)) - - if (npl_check /= npl) then - write(*,*) "Error reading in NetCDF file: The recorded value of npl does not match the number of active massive bodies" - call util_exit(failure) - end if - - if (ntp_check /= ntp) then - write(*,*) "Error reading in NetCDF file: The recorded value of ntp does not match the number of active test particles" - call util_exit(failure) - end if - - select type (pl) - class is (symba_pl) - select type (param) - class is (symba_parameters) - nplm_check = count(rtemp(:) > param%GMTINY .and. plmask(:)) - if (nplm_check /= pl%nplm) then - write(*,*) "Error reading in NetCDF file: The recorded value of nplm does not match the number of active fully interacting massive bodies" - call util_exit(failure) - end if - end select - end select - - ! Now read in each variable and split the outputs by body type - if ((param%in_form == XV) .or. (param%in_form == XVEL)) then - call check( nf90_get_var(iu%ncid, iu%xhx_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar xhx_varid" ) - if (npl > 0) pl%xh(1,:) = pack(rtemp, plmask) - if (ntp > 0) tp%xh(1,:) = pack(rtemp, tpmask) - - call check( nf90_get_var(iu%ncid, iu%xhy_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar xhy_varid" ) - if (npl > 0) pl%xh(2,:) = pack(rtemp, plmask) - if (ntp > 0) tp%xh(2,:) = pack(rtemp, tpmask) - - call check( nf90_get_var(iu%ncid, iu%xhz_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar xhz_varid" ) - if (npl > 0) pl%xh(3,:) = pack(rtemp, plmask) - if (ntp > 0) tp%xh(3,:) = pack(rtemp, tpmask) - - if (param%lgr .and. iu%lpseudo_vel_exists) then - call check( nf90_get_var(iu%ncid, iu%gr_pseudo_vhx_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar gr_pseudo_vhx_varid" ) - if (npl > 0) pl%vh(1,:) = pack(rtemp, plmask) - if (ntp > 0) tp%vh(1,:) = pack(rtemp, tpmask) - - call check( nf90_get_var(iu%ncid, iu%gr_pseudo_vhy_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar gr_pseudo_vhy_varid" ) - if (npl > 0) pl%vh(2,:) = pack(rtemp, plmask) - if (ntp > 0) tp%vh(2,:) = pack(rtemp, tpmask) - - call check( nf90_get_var(iu%ncid, iu%gr_pseudo_vhz_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar gr_pseudo_vhz_varid" ) - if (npl > 0) pl%vh(3,:) = pack(rtemp, plmask) - if (ntp > 0) tp%vh(3,:) = pack(rtemp, tpmask) - else - call check( nf90_get_var(iu%ncid, iu%vhx_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar vhx_varid" ) - if (npl > 0) pl%vh(1,:) = pack(rtemp, plmask) - if (ntp > 0) tp%vh(1,:) = pack(rtemp, tpmask) - - call check( nf90_get_var(iu%ncid, iu%vhy_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar vhy_varid" ) - if (npl > 0) pl%vh(2,:) = pack(rtemp, plmask) - if (ntp > 0) tp%vh(2,:) = pack(rtemp, tpmask) - - call check( nf90_get_var(iu%ncid, iu%vhz_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar vhz_varid" ) - if (npl > 0) pl%vh(3,:) = pack(rtemp, plmask) - if (ntp > 0) tp%vh(3,:) = pack(rtemp, tpmask) - end if - end if - - if ((param%in_form == EL) .or. (param%in_form == XVEL)) then - - call check( nf90_get_var(iu%ncid, iu%a_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar a_varid" ) - if (npl > 0) pl%a(:) = pack(rtemp, plmask) - if (ntp > 0) tp%a(:) = pack(rtemp, tpmask) - - call check( nf90_get_var(iu%ncid, iu%e_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar e_varid" ) - if (npl > 0) pl%e(:) = pack(rtemp, plmask) - if (ntp > 0) tp%e(:) = pack(rtemp, tpmask) - - call check( nf90_get_var(iu%ncid, iu%inc_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar inc_varid" ) - if (npl > 0) pl%inc(:) = pack(rtemp, plmask) - if (ntp > 0) tp%inc(:) = pack(rtemp, tpmask) - - call check( nf90_get_var(iu%ncid, iu%capom_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar capom_varid" ) - if (npl > 0) pl%capom(:) = pack(rtemp, plmask) - if (ntp > 0) tp%capom(:) = pack(rtemp, tpmask) - - call check( nf90_get_var(iu%ncid, iu%omega_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar omega_varid" ) - if (npl > 0) pl%omega(:) = pack(rtemp, plmask) - if (ntp > 0) tp%omega(:) = pack(rtemp, tpmask) - - call check( nf90_get_var(iu%ncid, iu%capm_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar capm_varid" ) - if (npl > 0) pl%capm(:) = pack(rtemp, plmask) - if (ntp > 0) tp%capm(:) = pack(rtemp, tpmask) - - end if - - call check( nf90_get_var(iu%ncid, iu%Gmass_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar Gmass_varid" ) - cb%Gmass = rtemp(1) - cb%mass = cb%Gmass / param%GU - - ! Set initial central body mass for Helio bookkeeping - select type(cb) - class is (symba_cb) - cb%GM0 = cb%Gmass - end select - - - if (npl > 0) then - pl%Gmass(:) = pack(rtemp, plmask) - pl%mass(:) = pl%Gmass(:) / param%GU - - if (param%lrhill_present) then - call check( nf90_get_var(iu%ncid, iu%rhill_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar rhill_varid" ) - pl%rhill(:) = pack(rtemp, plmask) - end if - end if - - if (param%lclose) then - call check( nf90_get_var(iu%ncid, iu%radius_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar radius_varid" ) - cb%radius = rtemp(1) - - ! Set initial central body radius for SyMBA bookkeeping - select type(cb) - class is (symba_cb) - cb%R0 = cb%radius - end select - if (npl > 0) pl%radius(:) = pack(rtemp, plmask) - else - cb%radius = param%rmin - if (npl > 0) pl%radius(:) = 0.0_DP - end if - - if (param%lrotation) then - call check( nf90_get_var(iu%ncid, iu%Ip1_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar Ip1_varid" ) - cb%Ip(1) = rtemp(1) - if (npl > 0) pl%Ip(1,:) = pack(rtemp, plmask) - - call check( nf90_get_var(iu%ncid, iu%Ip2_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar Ip2_varid" ) - cb%Ip(2) = rtemp(1) - if (npl > 0) pl%Ip(2,:) = pack(rtemp, plmask) - - call check( nf90_get_var(iu%ncid, iu%Ip3_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar Ip3_varid" ) - cb%Ip(3) = rtemp(1) - if (npl > 0) pl%Ip(3,:) = pack(rtemp, plmask) - - call check( nf90_get_var(iu%ncid, iu%rotx_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar rotx_varid" ) - cb%rot(1) = rtemp(1) - if (npl > 0) pl%rot(1,:) = pack(rtemp, plmask) - - call check( nf90_get_var(iu%ncid, iu%roty_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar roty_varid" ) - cb%rot(2) = rtemp(1) - if (npl > 0) pl%rot(2,:) = pack(rtemp, plmask) - - call check( nf90_get_var(iu%ncid, iu%rotz_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar rotz_varid" ) - cb%rot(3) = rtemp(1) - if (npl > 0) pl%rot(3,:) = pack(rtemp, plmask) - - ! Set initial central body angular momentum for Helio bookkeeping - select type(cb) - class is (symba_cb) - cb%L0(:) = cb%Ip(3) * cb%GM0 * cb%R0**2 * cb%rot(:) - end select - end if - - ! if (param%ltides) then - ! call check( nf90_get_var(iu%ncid, iu%k2_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar k2_varid" ) - ! cb%k2 = rtemp(1) - ! if (npl > 0) pl%k2(:) = pack(rtemp, plmask) - - ! call check( nf90_get_var(iu%ncid, iu%Q_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar Q_varid" ) - ! cb%Q = rtemp(1) - ! if (npl > 0) pl%Q(:) = pack(rtemp, plmask) - ! end if - - call check( nf90_get_var(iu%ncid, iu%j2rp2_varid, cb%j2rp2, start=[tslot]), "netcdf_read_frame_system nf90_getvar j2rp2_varid" ) - call check( nf90_get_var(iu%ncid, iu%j4rp4_varid, cb%j4rp4, start=[tslot]), "netcdf_read_frame_system nf90_getvar j4rp4_varid" ) - - call self%read_particle_info(iu, param, plmask, tpmask) - - ! if this is a GR-enabled run, check to see if we got the pseudovelocities in. Otherwise, we'll need to generate them. - if (param%lgr .and. .not.(iu%lpseudo_vel_exists)) then - call pl%set_mu(cb) - call tp%set_mu(cb) - call pl%v2pv(param) - call tp%v2pv(param) - end if - - end associate - - call iu%close() - - ierr = 0 - return - - 667 continue - write(*,*) "Error reading system frame in netcdf_read_frame_system" - - end function netcdf_read_frame_system - - - module subroutine netcdf_read_hdr_system(self, iu, param) - !! author: David A. Minton - !! - !! Reads header information (variables that change with time, but not particle id). - !! This subroutine significantly improves the output over the original binary file, allowing us to track energy, momentum, and other quantities that - !! previously were handled as separate output files. - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(netcdf_parameters), intent(inout) :: iu !! Parameters used to for writing a NetCDF dataset to file - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: tslot - - tslot = int(param%ioutput, kind=I4B) + 1 - - call check( nf90_get_var(iu%ncid, iu%time_varid, param%t, start=[tslot]), "netcdf_read_hdr_system nf90_getvar time_varid" ) - call check( nf90_get_var(iu%ncid, iu%npl_varid, self%pl%nbody, start=[tslot]), "netcdf_read_hdr_system nf90_getvar npl_varid" ) - call check( nf90_get_var(iu%ncid, iu%ntp_varid, self%tp%nbody, start=[tslot]), "netcdf_read_hdr_system nf90_getvar ntp_varid" ) - select type(pl => self%pl) - class is (symba_pl) - call check( nf90_get_var(iu%ncid, iu%nplm_varid, pl%nplm, start=[tslot]), "netcdf_read_hdr_system nf90_getvar nplm_varid" ) - end select - - if (param%lenergy) then - call check( nf90_get_var(iu%ncid, iu%KE_orb_varid, self%ke_orbit, start=[tslot]), "netcdf_read_hdr_system nf90_getvar KE_orb_varid" ) - call check( nf90_get_var(iu%ncid, iu%KE_spin_varid, self%ke_spin, start=[tslot]), "netcdf_read_hdr_system nf90_getvar KE_spin_varid" ) - call check( nf90_get_var(iu%ncid, iu%PE_varid, self%pe, start=[tslot]), "netcdf_read_hdr_system nf90_getvar PE_varid" ) - call check( nf90_get_var(iu%ncid, iu%L_orbx_varid, self%Lorbit(1), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_orbx_varid" ) - call check( nf90_get_var(iu%ncid, iu%L_orby_varid, self%Lorbit(2), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_orby_varid" ) - call check( nf90_get_var(iu%ncid, iu%L_orbz_varid, self%Lorbit(3), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_orbz_varid" ) - call check( nf90_get_var(iu%ncid, iu%L_spinx_varid, self%Lspin(1), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_spinx_varid" ) - call check( nf90_get_var(iu%ncid, iu%L_spiny_varid, self%Lspin(2), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_spiny_varid" ) - call check( nf90_get_var(iu%ncid, iu%L_spinz_varid, self%Lspin(3), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_spinz_varid" ) - call check( nf90_get_var(iu%ncid, iu%L_escapex_varid, self%Lescape(1), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_escapex_varid" ) - call check( nf90_get_var(iu%ncid, iu%L_escapey_varid, self%Lescape(2), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_escapey_varid" ) - call check( nf90_get_var(iu%ncid, iu%L_escapez_varid, self%Lescape(3), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_escapez_varid" ) - call check( nf90_get_var(iu%ncid, iu%Ecollisions_varid, self%Ecollisions, start=[tslot]), "netcdf_read_hdr_system nf90_getvar Ecollisions_varid" ) - call check( nf90_get_var(iu%ncid, iu%Euntracked_varid, self%Euntracked, start=[tslot]), "netcdf_read_hdr_system nf90_getvar Euntracked_varid" ) - call check( nf90_get_var(iu%ncid, iu%GMescape_varid, self%GMescape, start=[tslot]), "netcdf_read_hdr_system nf90_getvar GMescape_varid" ) - end if - - return - end subroutine netcdf_read_hdr_system - - - module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpmask) - !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton - !! - !! Reads particle information metadata from file - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(netcdf_parameters), intent(inout) :: iu !! 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 - ! Internals - integer(I4B) :: i, idmax - real(DP), dimension(:), allocatable :: rtemp - real(DP), dimension(:,:), allocatable :: rtemp_arr - integer(I4B), dimension(:), allocatable :: itemp - character(len=NAMELEN), dimension(:), allocatable :: ctemp - integer(I4B), dimension(:), allocatable :: plind, tpind - - ! This string of spaces of length NAMELEN is used to clear out any old data left behind inside the string variables - idmax = size(plmask) - allocate(rtemp(idmax)) - allocate(rtemp_arr(NDIM,idmax)) - allocate(itemp(idmax)) - allocate(ctemp(idmax)) - - associate(cb => self%cb, pl => self%pl, tp => self%tp, npl => self%pl%nbody, ntp => self%tp%nbody) - - if (npl > 0) then - pl%status(:) = ACTIVE - pl%lmask(:) = .true. - do i = 1, npl - call pl%info(i)%set_value(status="ACTIVE") - end do - allocate(plind(npl)) - plind(:) = pack([(i, i = 1, idmax)], plmask(:)) - end if - if (ntp > 0) then - tp%status(:) = ACTIVE - tp%lmask(:) = .true. - do i = 1, ntp - call tp%info(i)%set_value(status="ACTIVE") - end do - allocate(tpind(ntp)) - tpind(:) = pack([(i, i = 1, idmax)], tpmask(:)) - end if - - call check( nf90_get_var(iu%ncid, iu%id_varid, itemp), "netcdf_read_particle_info_system nf90_getvar id_varid" ) - cb%id = itemp(1) - pl%id(:) = pack(itemp, plmask) - tp%id(:) = pack(itemp, tpmask) - - call check( nf90_get_var(iu%ncid, iu%name_varid, ctemp, count=[NAMELEN, idmax]), "netcdf_read_particle_info_system nf90_getvar name_varid" ) - call cb%info%set_value(name=ctemp(1)) - do i = 1, npl - call pl%info(i)%set_value(name=ctemp(plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(name=ctemp(tpind(i))) - end do - - call check( nf90_get_var(iu%ncid, iu%ptype_varid, ctemp, count=[NAMELEN, idmax]), "netcdf_read_particle_info_system nf90_getvar ptype_varid" ) - call cb%info%set_value(particle_type=ctemp(1)) - do i = 1, npl - call pl%info(i)%set_value(particle_type=ctemp(plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(particle_type=ctemp(tpind(i))) - end do - - call check( nf90_get_var(iu%ncid, iu%status_varid, ctemp, count=[NAMELEN, idmax]), "netcdf_read_particle_info_system nf90_getvar status_varid" ) - call cb%info%set_value(status=ctemp(1)) - do i = 1, npl - call pl%info(i)%set_value(status=ctemp(plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(status=ctemp(tpind(i))) - end do - - if (param%lclose) then - call check( nf90_get_var(iu%ncid, iu%origin_type_varid, ctemp, count=[NAMELEN, idmax]), "netcdf_read_particle_info_system nf90_getvar origin_type_varid" ) - call cb%info%set_value(origin_type=ctemp(1)) - do i = 1, npl - call pl%info(i)%set_value(origin_type=ctemp(plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(origin_type=ctemp(tpind(i))) - end do - - call check( nf90_get_var(iu%ncid, iu%origin_time_varid, rtemp), "netcdf_read_particle_info_system nf90_getvar origin_time_varid" ) - call cb%info%set_value(origin_time=rtemp(1)) - do i = 1, npl - call pl%info(i)%set_value(origin_time=rtemp(plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(origin_time=rtemp(tpind(i))) - end do - - call check( nf90_get_var(iu%ncid, iu%origin_xhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar origin_xhx_varid" ) - call check( nf90_get_var(iu%ncid, iu%origin_xhy_varid, rtemp_arr(2,:)), "netcdf_read_particle_info_system nf90_getvar origin_xhy_varid" ) - call check( nf90_get_var(iu%ncid, iu%origin_xhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar origin_xhz_varid" ) - do i = 1, npl - call pl%info(i)%set_value(origin_xh=rtemp_arr(:,plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(origin_xh=rtemp_arr(:,tpind(i))) - end do - - call check( nf90_get_var(iu%ncid, iu%origin_vhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar origin_vhx_varid" ) - call check( nf90_get_var(iu%ncid, iu%origin_vhy_varid, rtemp_arr(2,:)), "netcdf_read_particle_info_system nf90_getvar origin_vhy_varid" ) - call check( nf90_get_var(iu%ncid, iu%origin_vhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar origin_vhz_varid" ) - do i = 1, npl - call pl%info(i)%set_value(origin_vh=rtemp_arr(:,plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(origin_vh=rtemp_arr(:,tpind(i))) - end do - - call check( nf90_get_var(iu%ncid, iu%collision_id_varid, itemp), "netcdf_read_particle_info_system nf90_getvar collision_id_varid" ) - do i = 1, npl - call pl%info(i)%set_value(collision_id=itemp(plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(collision_id=itemp(tpind(i))) - end do - - call check( nf90_get_var(iu%ncid, iu%discard_time_varid, rtemp), "netcdf_read_particle_info_system nf90_getvar discard_time_varid" ) - call cb%info%set_value(discard_time=rtemp(1)) - do i = 1, npl - call pl%info(i)%set_value(discard_time=rtemp(plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(discard_time=rtemp(tpind(i))) - end do - - call check( nf90_get_var(iu%ncid, iu%discard_xhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar discard_xhx_varid" ) - call check( nf90_get_var(iu%ncid, iu%discard_xhy_varid, rtemp_arr(2,:)), "netcdf_read_particle_info_system nf90_getvar discard_xhy_varid" ) - call check( nf90_get_var(iu%ncid, iu%discard_xhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar discard_xhz_varid" ) - do i = 1, npl - call pl%info(i)%set_value(discard_xh=rtemp_arr(:,plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(discard_xh=rtemp_arr(:,tpind(i))) - end do - - call check( nf90_get_var(iu%ncid, iu%discard_vhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar discard_vhx_varid" ) - call check( nf90_get_var(iu%ncid, iu%discard_vhy_varid, rtemp_arr(2,:)), "netcdf_read_particle_info_system nf90_getvar discard_vhy_varid" ) - call check( nf90_get_var(iu%ncid, iu%discard_vhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar discard_vhz_varid" ) - do i = 1, npl - call pl%info(i)%set_value(discard_vh=rtemp_arr(:,plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(discard_vh=rtemp_arr(:,tpind(i))) - end do - end if - - end associate - - return - end subroutine netcdf_read_particle_info_system - - - module subroutine netcdf_sync(self) - !! author: David A. Minton - !! - !! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) - !! - implicit none - ! Arguments - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - - call check( nf90_sync(self%ncid), "netcdf_sync nf90_sync" ) - - return - end subroutine netcdf_sync - - - module subroutine netcdf_write_frame_base(self, iu, param) - !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton - !! - !! Write a frame of output of either test particle or massive body data to the binary output file - !! Note: If outputting to orbital elements, but sure that the conversion is done prior to calling this method - implicit none - ! Arguments - class(swiftest_base), intent(in) :: self !! Swiftest particle object - class(netcdf_parameters), intent(inout) :: iu !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i, j, tslot, idslot, old_mode - integer(I4B), dimension(:), allocatable :: ind - real(DP), dimension(NDIM) :: vh !! Temporary variable to store heliocentric velocity values when converting from pseudovelocity in GR-enabled runs - real(DP) :: a, e, inc, omega, capom, capm - - call self%write_particle_info(iu, param) - - tslot = int(param%ioutput, kind=I4B) + 1 - - call check( nf90_set_fill(iu%ncid, nf90_nofill, old_mode), "netcdf_write_frame_base nf90_set_fill" ) - select type(self) - class is (swiftest_body) - associate(n => self%nbody) - if (n == 0) return - - call util_sort(self%id(1:n), ind) - - do i = 1, n - j = ind(i) - idslot = self%id(j) + 1 - - !! Convert from pseudovelocity to heliocentric without replacing the current value of pseudovelocity - if (param%lgr) call gr_pseudovel2vel(param, self%mu(j), self%xh(:, j), self%vh(:, j), vh(:)) - - if ((param%out_form == XV) .or. (param%out_form == XVEL)) then - call check( nf90_put_var(iu%ncid, iu%xhx_varid, self%xh(1, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var xhx_varid" ) - call check( nf90_put_var(iu%ncid, iu%xhy_varid, self%xh(2, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var xhy_varid" ) - call check( nf90_put_var(iu%ncid, iu%xhz_varid, self%xh(3, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var xhz_varid" ) - if (param%lgr) then !! Convert from pseudovelocity to heliocentric without replacing the current value of pseudovelocity - call check( nf90_put_var(iu%ncid, iu%vhx_varid, vh(1), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var vhx_varid (gr case)" ) - call check( nf90_put_var(iu%ncid, iu%vhy_varid, vh(2), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var vhy_varid (gr case)" ) - call check( nf90_put_var(iu%ncid, iu%vhz_varid, vh(3), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var vhz_varid (gr case)" ) - call check( nf90_put_var(iu%ncid, iu%gr_pseudo_vhx_varid, self%vh(1, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var gr_pseudo_vhx_varid" ) - call check( nf90_put_var(iu%ncid, iu%gr_pseudo_vhy_varid, self%vh(2, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var gr_pseudo_vhy_varid" ) - call check( nf90_put_var(iu%ncid, iu%gr_pseudo_vhz_varid, self%vh(3, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var gr_pseudo_vhz_varid" ) - - else - call check( nf90_put_var(iu%ncid, iu%vhx_varid, self%vh(1, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var vhx_varid" ) - call check( nf90_put_var(iu%ncid, iu%vhy_varid, self%vh(2, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var vhy_varid" ) - call check( nf90_put_var(iu%ncid, iu%vhz_varid, self%vh(3, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var vhz_varid" ) - end if - end if - - if ((param%out_form == EL) .or. (param%out_form == XVEL)) then - if (param%lgr) then !! For GR-enabled runs, use the true value of velocity computed above - call orbel_xv2el(self%mu(j), self%xh(1,j), self%xh(2,j), self%xh(3,j), & - vh(1), vh(2), vh(3), & - a, e, inc, capom, omega, capm) - else !! For non-GR runs just convert from the velocity we have - call orbel_xv2el(self%mu(j), self%xh(1,j), self%xh(2,j), self%xh(3,j), & - self%vh(1,j), self%vh(2,j), self%vh(3,j), & - a, e, inc, capom, omega, capm) - end if - call check( nf90_put_var(iu%ncid, iu%a_varid, a, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var a_varid" ) - call check( nf90_put_var(iu%ncid, iu%e_varid, e, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var e_varid" ) - call check( nf90_put_var(iu%ncid, iu%inc_varid, inc * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var inc_varid" ) - call check( nf90_put_var(iu%ncid, iu%capom_varid, capom * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var capom_varid" ) - call check( nf90_put_var(iu%ncid, iu%omega_varid, omega * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var omega_varid" ) - call check( nf90_put_var(iu%ncid, iu%capm_varid, capm * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var capm_varid" ) - end if - - select type(self) - class is (swiftest_pl) ! Additional output if the passed polymorphic object is a massive body - call check( nf90_put_var(iu%ncid, iu%Gmass_varid, self%Gmass(j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var Gmass_varid" ) - if (param%lrhill_present) then - call check( nf90_put_var(iu%ncid, iu%rhill_varid, self%rhill(j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var rhill_varid" ) - end if - if (param%lclose) call check( nf90_put_var(iu%ncid, iu%radius_varid, self%radius(j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var radius_varid" ) - if (param%lrotation) then - call check( nf90_put_var(iu%ncid, iu%Ip1_varid, self%Ip(1, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var Ip1_varid" ) - call check( nf90_put_var(iu%ncid, iu%Ip2_varid, self%Ip(2, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var Ip2_varid" ) - call check( nf90_put_var(iu%ncid, iu%Ip3_varid, self%Ip(3, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var Ip3_varid" ) - call check( nf90_put_var(iu%ncid, iu%rotx_varid, self%rot(1, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var rotx_varid" ) - call check( nf90_put_var(iu%ncid, iu%roty_varid, self%rot(2, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var roty_varid" ) - call check( nf90_put_var(iu%ncid, iu%rotz_varid, self%rot(3, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var rotz_varid" ) - end if - ! if (param%ltides) then - ! call check( nf90_put_var(iu%ncid, iu%k2_varid, self%k2(j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var k2_varid" ) - ! call check( nf90_put_var(iu%ncid, iu%Q_varid, self%Q(j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var Q_varid" ) - ! end if - - end select - end do - end associate - class is (swiftest_cb) - idslot = self%id + 1 - call check( nf90_put_var(iu%ncid, iu%id_varid, self%id, start=[idslot]), "netcdf_write_frame_base nf90_put_var cb id_varid" ) - - call check( nf90_put_var(iu%ncid, iu%Gmass_varid, self%Gmass, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb Gmass_varid" ) - if (param%lclose) call check( nf90_put_var(iu%ncid, iu%radius_varid, self%radius, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb radius_varid" ) - call check( nf90_put_var(iu%ncid, iu%j2rp2_varid, self%j2rp2, start=[tslot]), "netcdf_write_frame_base nf90_put_var cb j2rp2_varid" ) - call check( nf90_put_var(iu%ncid, iu%j4rp4_varid, self%j4rp4, start=[tslot]), "netcdf_write_frame_base nf90_put_var cb j4rp4_varid" ) - if (param%lrotation) then - call check( nf90_put_var(iu%ncid, iu%Ip1_varid, self%Ip(1), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb Ip1_varid" ) - call check( nf90_put_var(iu%ncid, iu%Ip2_varid, self%Ip(2), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb Ip2_varid" ) - call check( nf90_put_var(iu%ncid, iu%Ip3_varid, self%Ip(3), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb Ip3_varid" ) - call check( nf90_put_var(iu%ncid, iu%rotx_varid, self%rot(1), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb rotx_varid" ) - call check( nf90_put_var(iu%ncid, iu%roty_varid, self%rot(2), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb roty_varid" ) - call check( nf90_put_var(iu%ncid, iu%rotz_varid, self%rot(3), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb rotz_varid" ) - end if - ! if (param%ltides) then - ! call check( nf90_put_var(iu%ncid, iu%k2_varid, self%k2, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb k2_varid" ) - ! call check( nf90_put_var(iu%ncid, iu%Q_varid, self%Q, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb Q_varid" ) - ! end if - - end select - call check( nf90_set_fill(iu%ncid, old_mode, old_mode), "netcdf_write_frame_base nf90_set_fill old_mode" ) - - return - end subroutine netcdf_write_frame_base - - - module subroutine netcdf_write_frame_system(self, iu, param) - !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Write a frame (header plus records for each massive body and active test particle) to a output binary file - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(netcdf_parameters), intent(inout) :: iu !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - - call self%write_hdr(iu, param) - call self%cb%write_frame(iu, param) - call self%pl%write_frame(iu, param) - call self%tp%write_frame(iu, param) - - return - end subroutine netcdf_write_frame_system - - - module subroutine netcdf_write_particle_info_base(self, iu, param) - !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton - !! - !! Write all current particle to file - implicit none - ! Arguments - class(swiftest_base), intent(in) :: self !! Swiftest particle object - class(netcdf_parameters), intent(inout) :: iu !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i, j, idslot, old_mode - integer(I4B), dimension(:), allocatable :: ind - character(len=NAMELEN) :: charstring - - ! This string of spaces of length NAMELEN is used to clear out any old data left behind inside the string variables - call check( nf90_set_fill(iu%ncid, nf90_nofill, old_mode), "netcdf_write_particle_info_base nf90_set_fill nf90_nofill" ) - - select type(self) - class is (swiftest_body) - associate(n => self%nbody) - if (n == 0) return - call util_sort(self%id(1:n), ind) - - do i = 1, n - j = ind(i) - idslot = self%id(j) + 1 - call check( nf90_put_var(iu%ncid, iu%id_varid, self%id(j), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var id_varid" ) - - charstring = trim(adjustl(self%info(j)%name)) - call check( nf90_put_var(iu%ncid, iu%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_particle_info_base nf90_put_var name_varid" ) - - charstring = trim(adjustl(self%info(j)%particle_type)) - call check( nf90_put_var(iu%ncid, iu%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_particle_info_base nf90_put_var particle_type_varid" ) - - charstring = trim(adjustl(self%info(j)%status)) - call check( nf90_put_var(iu%ncid, iu%status_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_particle_info_base nf90_put_var status_varid" ) - - if (param%lclose) then - charstring = trim(adjustl(self%info(j)%origin_type)) - call check( nf90_put_var(iu%ncid, iu%origin_type_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_particle_info_base nf90_put_var origin_type_varid" ) - call check( nf90_put_var(iu%ncid, iu%origin_time_varid, self%info(j)%origin_time, start=[idslot]), "netcdf_write_particle_info_base nf90_put_var origin_time_varid" ) - call check( nf90_put_var(iu%ncid, iu%origin_xhx_varid, self%info(j)%origin_xh(1), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var origin_xhx_varid" ) - call check( nf90_put_var(iu%ncid, iu%origin_xhy_varid, self%info(j)%origin_xh(2), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var origin_xhy_varid" ) - call check( nf90_put_var(iu%ncid, iu%origin_xhz_varid, self%info(j)%origin_xh(3), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var origin_xhz_varid" ) - call check( nf90_put_var(iu%ncid, iu%origin_vhx_varid, self%info(j)%origin_vh(1), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var origin_vhx_varid" ) - call check( nf90_put_var(iu%ncid, iu%origin_vhy_varid, self%info(j)%origin_vh(2), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var origin_vhy_varid" ) - call check( nf90_put_var(iu%ncid, iu%origin_vhz_varid, self%info(j)%origin_vh(3), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var origin_vhz_varid" ) - - call check( nf90_put_var(iu%ncid, iu%collision_id_varid, self%info(j)%collision_id, start=[idslot]), "netcdf_write_particle_info_base nf90_put_var collision_id_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_time_varid, self%info(j)%discard_time, start=[idslot]), "netcdf_write_particle_info_base nf90_put_var discard_time_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_xhx_varid, self%info(j)%discard_xh(1), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var discard_xhx_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_xhy_varid, self%info(j)%discard_xh(2), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var discard_xhy_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_xhz_varid, self%info(j)%discard_xh(3), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var discard_xhz_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_vhx_varid, self%info(j)%discard_vh(1), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var discard_vhx_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_vhy_varid, self%info(j)%discard_vh(2), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var discard_vhy_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_vhz_varid, self%info(j)%discard_vh(3), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var discard_vhz_varid" ) - end if - - end do - end associate - - class is (swiftest_cb) - idslot = self%id + 1 - call check( nf90_put_var(iu%ncid, iu%id_varid, self%id, start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb id_varid" ) - - charstring = trim(adjustl(self%info%name)) - call check( nf90_put_var(iu%ncid, iu%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_particle_info_base nf90_put_var cb name_varid" ) - - charstring = trim(adjustl(self%info%particle_type)) - call check( nf90_put_var(iu%ncid, iu%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_particle_info_base nf90_put_var cb ptype_varid" ) - - charstring = trim(adjustl(self%info%status)) - call check( nf90_put_var(iu%ncid, iu%status_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_particle_info_base nf90_put_var cb status_varid" ) - - if (param%lclose) then - charstring = trim(adjustl(self%info%origin_type)) - call check( nf90_put_var(iu%ncid, iu%origin_type_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_particle_info_base nf90_put_var cb origin_type_varid" ) - - call check( nf90_put_var(iu%ncid, iu%origin_time_varid, self%info%origin_time, start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb origin_time_varid" ) - call check( nf90_put_var(iu%ncid, iu%origin_xhx_varid, self%info%origin_xh(1), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb origin_xhx_varid" ) - call check( nf90_put_var(iu%ncid, iu%origin_xhy_varid, self%info%origin_xh(2), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb origin_xhy_varid" ) - call check( nf90_put_var(iu%ncid, iu%origin_xhz_varid, self%info%origin_xh(3), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb origin_xhz_varid" ) - call check( nf90_put_var(iu%ncid, iu%origin_vhx_varid, self%info%origin_vh(1), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb origin_vhx_varid" ) - call check( nf90_put_var(iu%ncid, iu%origin_vhy_varid, self%info%origin_vh(2), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb origin_vhy_varid" ) - call check( nf90_put_var(iu%ncid, iu%origin_vhz_varid, self%info%origin_vh(3), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb origin_vhz_varid" ) - - call check( nf90_put_var(iu%ncid, iu%collision_id_varid, self%info%collision_id, start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb collision_id_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_time_varid, self%info%discard_time, start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb discard_time_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_xhx_varid, self%info%discard_xh(1), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb discard_xhx_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_xhy_varid, self%info%discard_xh(2), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb discard_xhy_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_xhz_varid, self%info%discard_xh(3), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb discard_xhz_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_vhx_varid, self%info%discard_vh(1), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb discard_vhx_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_vhy_varid, self%info%discard_vh(2), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb discard_vhy_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_vhz_varid, self%info%discard_vh(3), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb discard_vhz_varid" ) - end if - - end select - - call check( nf90_set_fill(iu%ncid, old_mode, old_mode) ) - return - end subroutine netcdf_write_particle_info_base - - - module subroutine netcdf_write_hdr_system(self, iu, param) - !! author: David A. Minton - !! - !! Writes header information (variables that change with time, but not particle id). - !! This subroutine significantly improves the output over the original binary file, allowing us to track energy, momentum, and other quantities that - !! previously were handled as separate output files. - implicit none - ! Arguments - class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object - class(netcdf_parameters), intent(inout) :: iu !! Parameters used to for writing a NetCDF dataset to file - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: tslot - - tslot = int(param%ioutput, kind=I4B) + 1 - - call check( nf90_put_var(iu%ncid, iu%time_varid, param%t, start=[tslot]), "netcdf_write_hdr_system nf90_put_var time_varid" ) - call check( nf90_put_var(iu%ncid, iu%npl_varid, self%pl%nbody, start=[tslot]), "netcdf_write_hdr_system nf90_put_var npl_varid" ) - call check( nf90_put_var(iu%ncid, iu%ntp_varid, self%tp%nbody, start=[tslot]), "netcdf_write_hdr_system nf90_put_var ntp_varid" ) - select type(pl => self%pl) - class is (symba_pl) - call check( nf90_put_var(iu%ncid, iu%nplm_varid, pl%nplm, start=[tslot]), "netcdf_write_hdr_system nf90_put_var nplm_varid" ) - end select - - if (param%lenergy) then - call check( nf90_put_var(iu%ncid, iu%KE_orb_varid, self%ke_orbit, start=[tslot]), "netcdf_write_hdr_system nf90_put_var KE_orb_varid" ) - call check( nf90_put_var(iu%ncid, iu%KE_spin_varid, self%ke_spin, start=[tslot]), "netcdf_write_hdr_system nf90_put_var KE_spin_varid" ) - call check( nf90_put_var(iu%ncid, iu%PE_varid, self%pe, start=[tslot]), "netcdf_write_hdr_system nf90_put_var PE_varid" ) - call check( nf90_put_var(iu%ncid, iu%L_orbx_varid, self%Lorbit(1), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_orbx_varid" ) - call check( nf90_put_var(iu%ncid, iu%L_orby_varid, self%Lorbit(2), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_orby_varid" ) - call check( nf90_put_var(iu%ncid, iu%L_orbz_varid, self%Lorbit(3), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_orbz_varid" ) - call check( nf90_put_var(iu%ncid, iu%L_spinx_varid, self%Lspin(1), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_spinx_varid" ) - call check( nf90_put_var(iu%ncid, iu%L_spiny_varid, self%Lspin(2), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_spiny_varid" ) - call check( nf90_put_var(iu%ncid, iu%L_spinz_varid, self%Lspin(3), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_spinz_varid" ) - call check( nf90_put_var(iu%ncid, iu%L_escapex_varid, self%Lescape(1), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_escapex_varid" ) - call check( nf90_put_var(iu%ncid, iu%L_escapey_varid, self%Lescape(2), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_escapey_varid" ) - call check( nf90_put_var(iu%ncid, iu%L_escapez_varid, self%Lescape(3), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_escapez_varid" ) - call check( nf90_put_var(iu%ncid, iu%Ecollisions_varid, self%Ecollisions, start=[tslot]), "netcdf_write_hdr_system nf90_put_var Ecollisions_varid" ) - call check( nf90_put_var(iu%ncid, iu%Euntracked_varid, self%Euntracked, start=[tslot]), "netcdf_write_hdr_system nf90_put_var Euntracked_varid" ) - call check( nf90_put_var(iu%ncid, iu%GMescape_varid, self%GMescape, start=[tslot]), "netcdf_write_hdr_system nf90_put_var GMescape_varid" ) - end if - - return - end subroutine netcdf_write_hdr_system - -end submodule s_netcdf diff --git a/src/netcdf_io/netcdf_io_implementations.f90 b/src/netcdf_io/netcdf_io_implementations.f90 new file mode 100644 index 000000000..9614e2a32 --- /dev/null +++ b/src/netcdf_io/netcdf_io_implementations.f90 @@ -0,0 +1,69 @@ +!! 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. + +submodule (netcdf_io) s_netcdf_io_implementations + use netcdf +contains + + module subroutine netcdf_io_check(status, call_identifier) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Checks the status of all NetCDF operations to catch errors + use netcdf + implicit none + ! Arguments + 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 + + if(status /= nf90_noerr) then + if (present(call_identifier)) write(*,*) "NetCDF error in ",trim(call_identifier) + write(*,*) trim(nf90_strerror(status)) + call util_exit(FAILURE) + end if + + return + end subroutine netcdf_io_check + + + module subroutine netcdf_io_close(self) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Closes a NetCDF file + use netcdf + implicit none + ! Arguments + class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + + if (self%lfile_is_open) then + call netcdf_io_check( nf90_close(self%id), "netcdf_io_close" ) + self%lfile_is_open = .false. + end if + + return + end subroutine netcdf_io_close + + + module subroutine netcdf_io_sync(self) + !! author: David A. Minton + !! + !! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) + !! + use netcdf + implicit none + ! Arguments + class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + + call netcdf_io_check( nf90_sync(self%id), "netcdf_io_sync nf90_sync" ) + + return + end subroutine netcdf_io_sync + + + +end submodule s_netcdf_io_implementations diff --git a/src/netcdf_io/netcdf_io_module.f90 b/src/netcdf_io/netcdf_io_module.f90 new file mode 100644 index 000000000..3926d2eea --- /dev/null +++ b/src/netcdf_io/netcdf_io_module.f90 @@ -0,0 +1,162 @@ +!! 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. + +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 + 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) :: name_chunk !! Chunk size for the id dimension variables + integer(I4B) :: time_chunk !! Chunk size for the time dimension variables + + ! 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 + + ! 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) :: 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 mass variable + integer(I4B) :: Gmass_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) :: L_orb_varname = "L_orb" !! name of the orbital angular momentum vector variable + integer(I4B) :: L_orb_varid !! ID for the system orbital angular momentum vector variable + character(NAMELEN) :: Lspin_varname = "Lspin" !! name of the spin angular momentum vector variable + integer(I4B) :: Lspin_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) :: Ecollisions_varname = "Ecollisions" !! name of the escaped angular momentum y variable + integer(I4B) :: Ecollisions_varid !! ID for the energy lost in collisions variable + character(NAMELEN) :: Euntracked_varname = "Euntracked" !! name of the energy that is untracked due to loss (untracked potential energy due to mergers and body energy for escaped bodies) + integer(I4B) :: Euntracked_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. + contains + procedure :: close => netcdf_io_close !! Closes an open NetCDF file + 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 + 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 + end subroutine netcdf_io_close + + module subroutine netcdf_io_sync(self) + implicit none + class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + end subroutine netcdf_io_sync + end interface + + +end module netcdf_io diff --git a/src/operators/operator_cross.f90 b/src/operator/operator_cross.f90 similarity index 98% rename from src/operators/operator_cross.f90 rename to src/operator/operator_cross.f90 index ba9582828..cec60d23b 100644 --- a/src/operators/operator_cross.f90 +++ b/src/operator/operator_cross.f90 @@ -7,11 +7,12 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(swiftest_operators) s_operator_cross +submodule(operators) s_operator_cross use swiftest !! author: David A. Minton !! !! Contains implementations for the .cross. operator for all defined integer and real types + !! Computes the cross product of two (3) vectors or (3,:) arrays !! Single vector implementations: C(1:3) = A(1:3) .cross. B(1:3) !! Vector list implementations: C(1:3, :) = A(1:3, :) .cross. B(1:3, :) contains diff --git a/src/operators/operator_mag.f90 b/src/operator/operator_mag.f90 similarity index 96% rename from src/operators/operator_mag.f90 rename to src/operator/operator_mag.f90 index bea89d55b..cdbd2b773 100644 --- a/src/operators/operator_mag.f90 +++ b/src/operator/operator_mag.f90 @@ -7,10 +7,11 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(swiftest_operators) s_operator_mag +submodule(operators) s_operator_mag !! author: David A. Minton !! !! Contains implementations for the .mag. operator for all defined real types + !! Computes the magnitude of a vector or array of vectors using norm2 !! Single vector implementations: B = .mag. A(1:3) !! Vector list implementations: B(:) = .mag. A(1:3, :) contains diff --git a/src/modules/swiftest_operators.f90 b/src/operator/operator_module.f90 similarity index 70% rename from src/modules/swiftest_operators.f90 rename to src/operator/operator_module.f90 index 30e5b26a6..8c351236b 100644 --- a/src/modules/swiftest_operators.f90 +++ b/src/operator/operator_module.f90 @@ -1,25 +1,25 @@ !! 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. +!! as published by the Free Software Foundation, either version NDIM 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 swiftest_operators +module operators !! author: David A. Minton !! !! Custom operators, including - !! A .cross. B = Cross product of A(1:3) and B(1:3) + !! A .cross. B = Cross product of A(1:NDIM) and B(1:NDIM) !! - !! Each operator can also do element-wise computation on arrays of the form .mag. A(1:3, 1:n) - use swiftest_globals + !! Each operator can also do element-wise computation on arrays of the form .mag. A(1:NDIM, 1:n) + use globals implicit none public !******************************************************************************************************************************** - ! Interfaces for .cross. operator + ! Interfaces for .cross. operator: Computes the cross product of two (NDIM) vectors or (NDIM,:) arrays !******************************************************************************************************************************** interface operator(.cross.) @@ -27,49 +27,49 @@ pure module function operator_cross_sp(A, B) result(C) !$omp declare simd(operator_cross_sp) implicit none real(SP), dimension(:), intent(in) :: A, B - real(SP), dimension(3) :: C + real(SP), dimension(NDIM) :: C end function operator_cross_sp pure module function operator_cross_dp(A, B) result(C) !$omp declare simd(operator_cross_dp) implicit none real(DP), dimension(:), intent(in) :: A, B - real(DP), dimension(3) :: C + real(DP), dimension(NDIM) :: C end function operator_cross_dp pure module function operator_cross_qp(A, B) result(C) !$omp declare simd(operator_cross_qp) implicit none real(QP), dimension(:), intent(in) :: A, B - real(QP), dimension(3) :: C + real(QP), dimension(NDIM) :: C end function operator_cross_qp pure module function operator_cross_i1b(A, B) result(C) !$omp declare simd(operator_cross_i1b) implicit none integer(I1B), dimension(:), intent(in) :: A, B - integer(I1B), dimension(3) :: C + integer(I1B), dimension(NDIM) :: C end function operator_cross_i1b pure module function operator_cross_i2b(A, B) result(C) !$omp declare simd(operator_cross_i2b) implicit none integer(I2B), dimension(:), intent(in) :: A, B - integer(I2B), dimension(3) :: C + integer(I2B), dimension(NDIM) :: C end function operator_cross_i2b pure module function operator_cross_i4b(A, B) result(C) !$omp declare simd(operator_cross_i4b) implicit none integer(I4B), dimension(:), intent(in) :: A, B - integer(I4B), dimension(3) :: C + integer(I4B), dimension(NDIM) :: C end function operator_cross_i4b pure module function operator_cross_i8b(A, B) result(C) !$omp declare simd(operator_cross_i8b) implicit none integer(I8B), dimension(:), intent(in) :: A, B - integer(I8B), dimension(3) :: C + integer(I8B), dimension(NDIM) :: C end function operator_cross_i8b pure module function operator_cross_el_sp(A, B) result(C) @@ -116,7 +116,7 @@ end function operator_cross_el_i8b end interface !******************************************************************************************************************************** - ! Interfaces for .mag. operator + ! Interfaces for .mag. operator: Computes the magnitude of a vector or array of vectors using norm2 !******************************************************************************************************************************** interface operator(.mag.) @@ -160,4 +160,51 @@ pure module function operator_mag_el_qp(A) result(B) end function operator_mag_el_qp end interface -end module swiftest_operators + + !******************************************************************************************************************************** + ! Interfaces for .unit. operator: Returns a unit vector or array of unit vectors from an input vector or array of vectors + !******************************************************************************************************************************** + + interface operator(.unit.) + pure module function operator_unit_sp(A) result(B) + !$omp declare simd(operator_unit_sp) + implicit none + real(SP), dimension(:), intent(in) :: A + real(SP), dimension(NDIM) :: B + end function operator_unit_sp + + pure module function operator_unit_dp(A) result(B) + !$omp declare simd(operator_unit_dp) + implicit none + real(DP), dimension(:), intent(in) :: A + real(DP), dimension(NDIM) :: B + end function operator_unit_dp + + pure module function operator_unit_qp(A) result(B) + !$omp declare simd(operator_unit_qp) + implicit none + real(QP), dimension(:), intent(in) :: A + real(QP), dimension(NDIM) :: B + end function operator_unit_qp + + pure module function operator_unit_el_sp(A) result(B) + implicit none + real(SP), dimension(:,:), intent(in) :: A + real(SP), dimension(:,:), allocatable :: B + end function operator_unit_el_sp + + pure module function operator_unit_el_dp(A) result(B) + implicit none + real(DP), dimension(:,:), intent(in) :: A + real(DP), dimension(:,:), allocatable :: B + end function operator_unit_el_dp + + pure module function operator_unit_el_qp(A) result(B) + implicit none + real(QP), dimension(:,:), intent(in) :: A + real(QP), dimension(:,:), allocatable :: B + end function operator_unit_el_qp + end interface + + +end module operators diff --git a/src/operator/operator_unit.f90 b/src/operator/operator_unit.f90 new file mode 100644 index 000000000..2b75e3851 --- /dev/null +++ b/src/operator/operator_unit.f90 @@ -0,0 +1,135 @@ +!! 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 NDIM 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. + +submodule(operators) s_operator_unit + !! author: David A. Minton + !! + !! Contains implementations for the .unit. operator for all defined real types + !! Returns a unit vector or array of unit vectors from an input vector or array of vectors + !! Single vector implementations: B = .unit. A(1:NDIM) + !! Vector list implementations: B(:) = .unit. A(1:NDIM, :) + contains + + pure module function operator_unit_sp(A) result(B) + implicit none + ! Arguments + real(SP), dimension(:), intent(in) :: A + real(SP), dimension(NDIM) :: B + ! Internals + real(SP) :: Amag + + Amag = norm2(A(:)) + if (Amag > tiny(1._SP)) then + B(:) = A(:) / Amag + else + B(:) = 0.0_SP + end if + + return + end function operator_unit_sp + + + pure module function operator_unit_dp(A) result(B) + implicit none + ! Arguments + real(DP), dimension(:), intent(in) :: A + real(DP), dimension(NDIM) :: B + ! Internals + real(DP) :: Amag + + Amag = norm2(A(:)) + if (Amag > tiny(1._DP)) then + B(:) = A(:) / Amag + else + B(:) = 0.0_DP + end if + + return + end function operator_unit_dp + + + pure module function operator_unit_qp(A) result(B) + implicit none + ! Arguments + real(QP), dimension(:), intent(in) :: A + real(QP), dimension(NDIM) :: B + ! Internals + real(QP) :: Amag + + Amag = norm2(A(:)) + if (Amag > tiny(1._QP)) then + B(:) = A(:) / Amag + else + B(:) = 0.0_QP + end if + + return + end function operator_unit_qp + + + pure module function operator_unit_el_sp(A) result(B) + implicit none + ! Arguments + real(SP), dimension(:,:), intent(in) :: A + real(SP), dimension(:,:), allocatable :: B + ! Internals + integer(I4B) :: i,n + + n = size(A, 2) + if (allocated(B)) deallocate(B) + allocate(B(NDIM,n)) + + do concurrent (i=1:n) + B(:,i) = operator_unit_sp(A(:,i)) + end do + + return + end function operator_unit_el_sp + + + pure module function operator_unit_el_dp(A) result(B) + implicit none + ! Arguments + real(DP), dimension(:,:), intent(in) :: A + real(DP), dimension(:,:), allocatable :: B + ! Internals + integer(I4B) :: i,n + + n = size(A, 2) + if (allocated(B)) deallocate(B) + allocate(B(NDIM,n)) + + do concurrent (i=1:n) + B(:,i) = operator_unit_dp(A(:,i)) + end do + + return + end function operator_unit_el_dp + + pure module function operator_unit_el_qp(A) result(B) + implicit none + ! Arguments + real(QP), dimension(:,:), intent(in) :: A + real(QP), dimension(:,:), allocatable :: B + ! Internals + integer(I4B) :: i,n + + n = size(A, 2) + if (allocated(B)) deallocate(B) + allocate(B(NDIM,n)) + + do concurrent (i=1:n) + B(:,i) = operator_unit_qp(A(:,i)) + end do + + return + end function operator_unit_el_qp + +end submodule s_operator_unit + diff --git a/src/rmvs/rmvs_discard.f90 b/src/rmvs/rmvs_discard.f90 index 732cbdea0..5a8fd94f5 100644 --- a/src/rmvs/rmvs_discard.f90 +++ b/src/rmvs/rmvs_discard.f90 @@ -7,11 +7,11 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(rmvs_classes) s_rmvs_discard +submodule(rmvs) s_rmvs_discard use swiftest contains - module subroutine rmvs_discard_tp(self, system, param) + module subroutine rmvs_discard_tp(self, nbody_system, param) !! author: David A. Minton !! !! Check to see if test particles should be discarded based on pericenter passage distances with respect to planets encountered @@ -21,7 +21,7 @@ module subroutine rmvs_discard_tp(self, system, param) implicit none ! Arguments class(rmvs_tp), intent(inout) :: self !! RMVS test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i @@ -29,7 +29,7 @@ module subroutine rmvs_discard_tp(self, system, param) if (self%nbody == 0) return - associate(tp => self, ntp => self%nbody, pl => system%pl, t => param%t) + associate(tp => self, ntp => self%nbody, pl => nbody_system%pl, t => nbody_system%t) do i = 1, ntp associate(iplperP => tp%plperP(i)) if ((tp%status(i) == ACTIVE) .and. (tp%lperi(i))) then @@ -43,14 +43,14 @@ module subroutine rmvs_discard_tp(self, system, param) // " (" // trim(adjustl(idstrj)) // ") is too small at t = " // trim(adjustl(timestr)) tp%ldiscard(i) = .true. tp%lmask(i) = .false. - call tp%info(i)%set_value(status="DISCARDED_PLQ", discard_time=t, discard_xh=tp%xh(:,i), & + 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 end if end associate end do ! Call the base method that this overrides - call discard_tp(tp, system, param) + call swiftest_discard_tp(tp, nbody_system, param) end associate end subroutine rmvs_discard_tp diff --git a/src/rmvs/rmvs_encounter_check.f90 b/src/rmvs/rmvs_encounter_check.f90 index cf6b73624..00aafd1fb 100644 --- a/src/rmvs/rmvs_encounter_check.f90 +++ b/src/rmvs/rmvs_encounter_check.f90 @@ -7,11 +7,11 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (rmvs_classes) s_rmvs_chk +submodule (rmvs) s_rmvs_encounter_check use swiftest contains - module function rmvs_encounter_check_tp(self, param, system, dt) result(lencounter) + module function rmvs_encounter_check_tp(self, param, nbody_system, dt) result(lencounter) !! author: David A. Minton !! !! Determine whether a test particle and planet are having or will have an encounter within the next time step @@ -22,7 +22,7 @@ module function rmvs_encounter_check_tp(self, param, system, dt) result(lencount ! Arguments class(rmvs_tp), intent(inout) :: self !! RMVS test particle object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(rmvs_nbody_system), intent(inout) :: system !! RMVS nbody system object + class(rmvs_nbody_system), intent(inout) :: nbody_system !! RMVS nbody system object real(DP), intent(in) :: dt !! step size ! Result logical :: lencounter !! Returns true if there is at least one close encounter @@ -38,11 +38,11 @@ module function rmvs_encounter_check_tp(self, param, system, dt) result(lencount lencounter = .false. if (self%nbody == 0) return - select type(pl => system%pl) + select type(pl => nbody_system%pl) class is (rmvs_pl) associate(tp => self, ntp => self%nbody, npl => pl%nbody) tp%plencP(1:ntp) = 0 - call encounter_check_all_pltp(param, npl, ntp, pl%xbeg, pl%vbeg, tp%xh, tp%vh, pl%renc, dt, & + call encounter_check_all_pltp(param, npl, ntp, pl%rbeg, pl%vbeg, tp%rh, tp%vh, pl%renc, dt, & nenc, index1, index2, lvdotr) lencounter = (nenc > 0_I8B) @@ -59,4 +59,4 @@ module function rmvs_encounter_check_tp(self, param, system, dt) result(lencount end function rmvs_encounter_check_tp -end submodule s_rmvs_chk +end submodule s_rmvs_encounter_check diff --git a/src/rmvs/rmvs_io.f90 b/src/rmvs/rmvs_io.f90 deleted file mode 100644 index 4d04dc150..000000000 --- a/src/rmvs/rmvs_io.f90 +++ /dev/null @@ -1,56 +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. - -submodule (rmvs_classes) s_rmvs_io - use swiftest -contains - - module subroutine rmvs_io_write_encounter(t, id1, id2, Gmass1, Gmass2, radius1, radius2, & - xh1, xh2, vh1, vh2, enc_out) - !! author: David A. Minton - !! - !! Write close encounter data from RMVS to output binary files - !! There is no direct file output from this subroutine - !! - !! Adapted from David E. Kaufmann's Swifter routine: io_write_encounter.f90 - !! Adapted from Hal Levison's Swift routine io_write_encounter.f - implicit none - ! Arguments - integer(I4B), intent(in) :: id1, id2 - real(DP), intent(in) :: t, Gmass1, Gmass2, radius1, radius2 - real(DP), dimension(:), intent(in) :: xh1, xh2, vh1, vh2 - character(*), intent(in) :: enc_out - ! Internals - logical , save :: lfirst = .true. - integer(I4B) :: ierr - - if (enc_out == "") return - - open(unit = LUN, file = enc_out, status = 'OLD', position = 'APPEND', form = 'UNFORMATTED', iostat = ierr) - if ((ierr /= 0) .and. lfirst) then - open(unit = LUN, file = enc_out, status = 'NEW', form = 'UNFORMATTED', iostat = ierr) - end if - if (ierr /= 0) then - write(*, *) "Swiftest Error:" - write(*, *) " Unable to open binary encounter file" - call util_exit(FAILURE) - end if - lfirst = .false. - call encounter_io_write_frame(LUN, t, id1, id2, Gmass1, Gmass2, radius1, radius2, xh1, xh2, vh1, vh2) - close(unit = LUN, iostat = ierr) - if (ierr /= 0) then - write(*, *) "Swiftest Error:" - write(*, *) " Unable to close binary encounter file" - call util_exit(FAILURE) - end if - - return - end subroutine rmvs_io_write_encounter - -end submodule s_rmvs_io \ No newline at end of file diff --git a/src/rmvs/rmvs_kick.f90 b/src/rmvs/rmvs_kick.f90 index 91e63a62e..7d113f863 100644 --- a/src/rmvs/rmvs_kick.f90 +++ b/src/rmvs/rmvs_kick.f90 @@ -7,11 +7,11 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(rmvs_classes) s_rmvs_kick +submodule(rmvs) s_rmvs_kick use swiftest contains - module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) + module subroutine rmvs_kick_getacch_tp(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Compute the oblateness acceleration in the inner encounter region with planets @@ -21,32 +21,32 @@ module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) implicit none ! Arguments class(rmvs_tp), intent(inout) :: self !! RMVS test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest central body particle data structuree + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest central body particle data structuree class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step ! Internals class(swiftest_parameters), allocatable :: param_planetocen - real(DP), dimension(:, :), allocatable :: xh_original + real(DP), dimension(:, :), allocatable :: rh_original real(DP) :: GMcb_original integer(I4B) :: i if (self%nbody == 0) return associate(tp => self, ntp => self%nbody, ipleP => self%ipleP, inner_index => self%index) - select type(system) + select type(nbody_system) class is (rmvs_nbody_system) - if (system%lplanetocentric) then ! This is a close encounter step, so any accelerations requiring heliocentric position values + if (nbody_system%lplanetocentric) then ! This is a close encounter step, so any accelerations requiring heliocentric position values ! must be handeled outside the normal WHM method call - select type(pl => system%pl) + select type(pl => nbody_system%pl) class is (rmvs_pl) - select type (cb => system%cb) + select type (cb => nbody_system%cb) class is (rmvs_cb) - associate(xpc => pl%xh, xpct => self%xh, apct => self%ah, system_planetocen => system) + associate(xpc => pl%rh, xpct => self%rh, apct => self%ah, system_planetocen => nbody_system) system_planetocen%lbeg = lbeg ! Save the original heliocentric position for later - allocate(xh_original, source=tp%xh) + allocate(rh_original, source=tp%rh) ! 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) @@ -60,17 +60,17 @@ module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) ! Now compute any heliocentric values of acceleration if (tp%lfirst) then do concurrent(i = 1:ntp, tp%lmask(i)) - tp%xheliocentric(:,i) = tp%xh(:,i) + cb%inner(inner_index - 1)%x(:,1) + tp%rheliocentric(:,i) = tp%rh(:,i) + cb%inner(inner_index - 1)%x(:,1) end do else do concurrent(i = 1:ntp, tp%lmask(i)) - tp%xheliocentric(:,i) = tp%xh(:,i) + cb%inner(inner_index )%x(:,1) + tp%rheliocentric(:,i) = tp%rh(:,i) + cb%inner(inner_index )%x(:,1) end do end if ! Swap the planetocentric and heliocentric position vectors and central body masses do concurrent(i = 1:ntp, tp%lmask(i)) - tp%xh(:, i) = tp%xheliocentric(:, i) + tp%rh(:, i) = tp%rheliocentric(:, i) end do GMcb_original = cb%Gmass cb%Gmass = tp%cb_heliocentric%Gmass @@ -81,14 +81,14 @@ module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) if (param%lgr) call tp%accel_gr(param) ! Put everything back the way we found it - call move_alloc(xh_original, tp%xh) + call move_alloc(rh_original, tp%rh) cb%Gmass = GMcb_original end associate end select end select else ! Not a close encounter, so just proceded with the standard WHM method - call whm_kick_getacch_tp(tp, system, param, t, lbeg) + call whm_kick_getacch_tp(tp, nbody_system, param, t, lbeg) end if end select end associate diff --git a/src/modules/rmvs_classes.f90 b/src/rmvs/rmvs_module.f90 similarity index 76% rename from src/modules/rmvs_classes.f90 rename to src/rmvs/rmvs_module.f90 index 7fe65ffc9..3417ea0e2 100644 --- a/src/modules/rmvs_classes.f90 +++ b/src/rmvs/rmvs_module.f90 @@ -7,13 +7,13 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -module rmvs_classes +module rmvs !! author: David A. Minton !! - !! Definition of classes and methods specific to the Regularized Mixed Variable Symplectic (RMVS) integrator + !! Definition of classes and methods specific to the Regularized Mixed Variable Symplectic (INT_RMVS) integrator !! Partially adapted from David E. Kaufmann's Swifter module: module_rmvs.f90 - use swiftest_globals - use whm_classes, only : whm_cb, whm_pl, whm_tp, whm_nbody_system + use swiftest + use whm implicit none public @@ -24,19 +24,17 @@ module rmvs_classes real(DP), private, parameter :: RHPSCALE = 1.0_DP real(DP), private, parameter :: FACQDT = 2.0_DP - !******************************************************************************************************************************** - ! rmvs_nbody_system class definitions and method interfaces - !******************************************************************************************************************************** + + !> In the RMVS integrator, pl-tp encounters are handeled, but not pl-pl type, extends(whm_nbody_system) :: rmvs_nbody_system - !> In the RMVS integrator, only test particles are discarded logical :: lplanetocentric = .false. !! Flag that indicates that the object is a planetocentric set of masive bodies used for close encounter calculations real(DP) :: rts !! fraction of Hill's sphere radius to use as radius of encounter region real(DP), dimension(:,:), allocatable :: vbeg !! Planet velocities at beginning ot step contains !> Replace the abstract procedures with concrete ones - procedure :: initialize => rmvs_setup_initialize_system !! Performs RMVS-specific initilization steps, including generating the close encounter planetocentric structures + procedure :: initialize => rmvs_util_setup_initialize_system !! Performs RMVS-specific initilization steps, including generating the close encounter planetocentric structures procedure :: step => rmvs_step_system !! Advance the RMVS nbody system forward in time by one step - final :: rmvs_util_final_system !! Finalizes the RMVS nbody system object - deallocates all allocatables + final :: rmvs_final_system !! Finalizes the RMVS nbody system object - deallocates all allocatables end type rmvs_nbody_system type, private :: rmvs_interp @@ -46,12 +44,10 @@ module rmvs_classes real(DP), dimension(:, :), allocatable :: atide !! Encountering planet's tidal acceleration value contains procedure :: dealloc => rmvs_util_dealloc_interp !! Deallocates all allocatable arrays - final :: rmvs_util_final_interp !! Finalizes the RMVS interpolated system variables object - deallocates all allocatables + final :: rmvs_final_interp !! Finalizes the RMVS interpolated nbody_system variables object - deallocates all allocatables end type rmvs_interp - !******************************************************************************************************************************** - ! rmvs_cb class definitions and method interfaces - !******************************************************************************************************************************* + !> RMVS central body particle class type, extends(whm_cb) :: rmvs_cb type(rmvs_interp), dimension(:), allocatable :: outer !! interpolated heliocentric central body position for outer encounters @@ -59,17 +55,14 @@ module rmvs_classes logical :: lplanetocentric = .false. !! Flag that indicates that the object is a planetocentric set of masive bodies used for close encounter calculations contains procedure :: dealloc => rmvs_util_dealloc_cb !! Deallocates all allocatable arrays - final :: rmvs_util_final_cb !! Finalizes the RMVS central body object - deallocates all allocatables + final :: rmvs_final_cb !! Finalizes the RMVS central body object - deallocates all allocatables end type rmvs_cb - !******************************************************************************************************************************** - ! rmvs_tp class definitions and method interfaces - !******************************************************************************************************************************* !! RMVS test particle class type, extends(whm_tp) :: rmvs_tp !! Note to developers: If you add componenets to this class, be sure to update methods and subroutines that traverse the - !! component list, such as rmvs_setup_tp and rmvs_util_spill_tp + !! component list, such as rmvs_util_setup_tp and rmvs_util_spill_tp ! encounter steps) logical, dimension(:), allocatable :: lperi !! planetocentric pericenter passage flag (persistent for a full rmvs time step) over a full RMVS time step) integer(I4B), dimension(:), allocatable :: plperP !! index of planet associated with pericenter distance peri (persistent over a full RMVS time step) @@ -77,7 +70,7 @@ module rmvs_classes ! The following are used to correctly set the oblateness values of the acceleration during an inner encounter with a planet type(rmvs_cb) :: cb_heliocentric !! Copy of original central body object passed to close encounter (used for oblateness acceleration during planetocentric encoountters) - real(DP), dimension(:,:), allocatable :: xheliocentric !! original heliocentric position (used for oblateness calculation during close encounters) + real(DP), dimension(:,:), allocatable :: rheliocentric !! original heliocentric position (used for oblateness calculation during close encounters) integer(I4B) :: index !! inner substep number within current set integer(I4B) :: ipleP !! index value of encountering planet logical :: lplanetocentric = .false. !! Flag that indicates that the object is a planetocentric set of masive bodies used for close encounter calculations @@ -86,7 +79,7 @@ module rmvs_classes procedure :: encounter_check => rmvs_encounter_check_tp !! Checks if any test particles are undergoing a close encounter with a massive body procedure :: accel => rmvs_kick_getacch_tp !! Calculates either the standard or modified version of the acceleration depending if the !! if the test particle is undergoing a close encounter or not - procedure :: setup => rmvs_setup_tp !! Constructor method - Allocates space for the input number of bodiess + procedure :: setup => rmvs_util_setup_tp !! Constructor method - Allocates space for the input number of bodiess procedure :: append => rmvs_util_append_tp !! Appends elements from one structure to another procedure :: dealloc => rmvs_util_dealloc_tp !! Deallocates all allocatable arrays procedure :: fill => rmvs_util_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) @@ -94,12 +87,9 @@ module rmvs_classes procedure :: sort => rmvs_util_sort_tp !! Sorts body arrays by a sortable componen procedure :: rearrange => rmvs_util_sort_rearrange_tp !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods procedure :: spill => rmvs_util_spill_tp !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - final :: rmvs_util_final_tp !! Finalizes the RMVS test particle object - deallocates all allocatables + final :: rmvs_final_tp !! Finalizes the RMVS test particle object - deallocates all allocatables end type rmvs_tp - !******************************************************************************************************************************** - ! rmvs_pl class definitions and method interfaces - !******************************************************************************************************************************* !> RMVS massive body particle class type, extends(whm_pl) :: rmvs_pl @@ -111,7 +101,7 @@ module rmvs_classes class(rmvs_nbody_system), dimension(:), allocatable :: planetocentric !! Planetocentric version of the massive body objects (one for each massive body) logical :: lplanetocentric = .false. !! Flag that indicates that the object is a planetocentric set of masive bodies used for close encounter calculations contains - procedure :: setup => rmvs_setup_pl !! Constructor method - Allocates space for the input number of bodiess + procedure :: setup => rmvs_util_setup_pl !! Constructor method - Allocates space for the input number of bodiess procedure :: append => rmvs_util_append_pl !! Appends elements from one structure to another procedure :: dealloc => rmvs_util_dealloc_pl !! Deallocates all allocatable arrays procedure :: fill => rmvs_util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) @@ -119,71 +109,56 @@ module rmvs_classes procedure :: sort => rmvs_util_sort_pl !! Sorts body arrays by a sortable componen procedure :: rearrange => rmvs_util_sort_rearrange_pl !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods procedure :: spill => rmvs_util_spill_pl !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - final :: rmvs_util_final_pl !! Finalizes the RMVS massive body object - deallocates all allocatables + final :: rmvs_final_pl !! Finalizes the RMVS massive body object - deallocates all allocatables end type rmvs_pl interface - module subroutine rmvs_discard_tp(self, system, param) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters + module subroutine rmvs_discard_tp(self, nbody_system, param) implicit none class(rmvs_tp), intent(inout) :: self !! RMVS test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system 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 rmvs_discard_tp - module function rmvs_encounter_check_tp(self, param, system, dt) result(lencounter) - use swiftest_classes, only : swiftest_parameters + module function rmvs_encounter_check_tp(self, param, nbody_system, dt) result(lencounter) implicit none class(rmvs_tp), intent(inout) :: self !! RMVS test particle object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(rmvs_nbody_system), intent(inout) :: system !! RMVS nbody system object + class(rmvs_nbody_system), intent(inout) :: nbody_system !! RMVS nbody system object real(DP), intent(in) :: dt !! step size logical :: lencounter !! Returns true if there is at least one close encounter end function rmvs_encounter_check_tp - module subroutine rmvs_io_write_encounter(t, id1, id2, Gmass1, Gmass2, radius1, radius2, xh1, xh2, vh1, vh2, enc_out) - implicit none - integer(I4B), intent(in) :: id1, id2 - real(DP), intent(in) :: t, Gmass1, Gmass2, radius1, radius2 - real(DP), dimension(:), intent(in) :: xh1, xh2, vh1, vh2 - character(*), intent(in) :: enc_out - end subroutine rmvs_io_write_encounter - - module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters + module subroutine rmvs_kick_getacch_tp(self, nbody_system, param, t, lbeg) implicit none class(rmvs_tp), intent(inout) :: self !! RMVS test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest central body particle data structuree + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest central body particle data structuree class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine rmvs_kick_getacch_tp - module subroutine rmvs_setup_pl(self, n, param) - use swiftest_classes, only : swiftest_parameters + module subroutine rmvs_util_setup_pl(self, n, param) implicit none class(rmvs_pl), intent(inout) :: self !! RMVS 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 rmvs_setup_pl + end subroutine rmvs_util_setup_pl - module subroutine rmvs_setup_initialize_system(self, param) - use swiftest_classes, only : swiftest_parameters + module subroutine rmvs_util_setup_initialize_system(self, param) implicit none class(rmvs_nbody_system), intent(inout) :: self !! RMVS system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine rmvs_setup_initialize_system + end subroutine rmvs_util_setup_initialize_system - module subroutine rmvs_setup_tp(self, n, param) - use swiftest_classes, only : swiftest_parameters + module subroutine rmvs_util_setup_tp(self, n, param) implicit none class(rmvs_tp), intent(inout) :: self !! RMVS test particle object integer(I4B), intent(in) :: n !! Number of particles to allocate space for class(swiftest_parameters), intent(in) :: param !! Current run configuration parametere - end subroutine rmvs_setup_tp + end subroutine rmvs_util_setup_tp module subroutine rmvs_util_append_pl(self, source, lsource_mask) - use swiftest_classes, only : swiftest_body implicit none class(rmvs_pl), intent(inout) :: self !! RMVS massive body object class(swiftest_body), intent(in) :: source !! Source object to append @@ -191,7 +166,6 @@ module subroutine rmvs_util_append_pl(self, source, lsource_mask) end subroutine rmvs_util_append_pl module subroutine rmvs_util_append_tp(self, source, lsource_mask) - use swiftest_classes, only : swiftest_body implicit none class(rmvs_tp), intent(inout) :: self !! RMVS test particle object class(swiftest_body), intent(in) :: source !! Source object to append @@ -205,7 +179,7 @@ end subroutine rmvs_util_dealloc_cb module subroutine rmvs_util_dealloc_interp(self) implicit none - class(rmvs_interp), intent(inout) :: self !! RMVS interpolated system variables object + class(rmvs_interp), intent(inout) :: self !! RMVS interpolated nbody_system variables object end subroutine rmvs_util_dealloc_interp module subroutine rmvs_util_dealloc_pl(self) @@ -219,7 +193,6 @@ module subroutine rmvs_util_dealloc_tp(self) end subroutine rmvs_util_dealloc_tp module subroutine rmvs_util_fill_pl(self, inserts, lfill_list) - use swiftest_classes, only : swiftest_body implicit none class(rmvs_pl), intent(inout) :: self !! RMVS massive body object class(swiftest_body), intent(in) :: inserts !! Inserted object @@ -227,38 +200,12 @@ module subroutine rmvs_util_fill_pl(self, inserts, lfill_list) end subroutine rmvs_util_fill_pl module subroutine rmvs_util_fill_tp(self, inserts, lfill_list) - use swiftest_classes, only : swiftest_body implicit none class(rmvs_tp), intent(inout) :: self !! RMVS massive 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 end subroutine rmvs_util_fill_tp - module subroutine rmvs_util_final_cb(self) - implicit none - type(rmvs_cb), intent(inout) :: self !! RMVS central body object - end subroutine rmvs_util_final_cb - - module subroutine rmvs_util_final_interp(self) - implicit none - type(rmvs_interp), intent(inout) :: self !! RMVS interpolated system variables object - end subroutine rmvs_util_final_interp - - module subroutine rmvs_util_final_pl(self) - implicit none - type(rmvs_pl), intent(inout) :: self !! RMVS massive body object - end subroutine rmvs_util_final_pl - - module subroutine rmvs_util_final_system(self) - implicit none - type(rmvs_nbody_system), intent(inout) :: self !! RMVS nbody system object - end subroutine rmvs_util_final_system - - module subroutine rmvs_util_final_tp(self) - implicit none - type(rmvs_tp), intent(inout) :: self !! RMVS test particle object - end subroutine rmvs_util_final_tp - module subroutine rmvs_util_resize_pl(self, nnew) implicit none class(rmvs_pl), intent(inout) :: self !! RMVS massive body object @@ -298,7 +245,6 @@ module subroutine rmvs_util_sort_rearrange_tp(self, ind) end subroutine rmvs_util_sort_rearrange_tp module subroutine rmvs_util_spill_pl(self, discards, lspill_list, ldestructive) - use swiftest_classes, only : swiftest_body implicit none class(rmvs_pl), intent(inout) :: self !! RMVS massive body object class(swiftest_body), intent(inout) :: discards !! Discarded object @@ -307,7 +253,6 @@ module subroutine rmvs_util_spill_pl(self, discards, lspill_list, ldestructive) end subroutine rmvs_util_spill_pl module subroutine rmvs_util_spill_tp(self, discards, lspill_list, ldestructive) - use swiftest_classes, only : swiftest_body implicit none class(rmvs_tp), intent(inout) :: self !! RMVS test particle object class(swiftest_body), intent(inout) :: discards !! Discarded object @@ -316,7 +261,6 @@ module subroutine rmvs_util_spill_tp(self, discards, lspill_list, ldestructive) end subroutine rmvs_util_spill_tp module subroutine rmvs_step_system(self, param, t, dt) - use swiftest_classes, only : swiftest_parameters implicit none class(rmvs_nbody_system), intent(inout) :: self !! RMVS nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters @@ -326,4 +270,77 @@ end subroutine rmvs_step_system end interface -end module rmvs_classes + contains + + subroutine rmvs_final_cb(self) + !! author: David A. Minton + !! + !! Finalize the RMVS massive body object - deallocates all allocatables + implicit none + ! Arguments + type(rmvs_cb), intent(inout) :: self !! RMVS central body object + + call self%dealloc() + + return + end subroutine rmvs_final_cb + + + subroutine rmvs_final_interp(self) + !! author: David A. Minton + !! + !! Finalize the RMVS nbody system object - deallocates all allocatables + implicit none + ! Arguments + type(rmvs_interp), intent(inout) :: self !! RMVS nbody system object + + call self%dealloc() + + return + end subroutine rmvs_final_interp + + + subroutine rmvs_final_pl(self) + !! author: David A. Minton + !! + !! Finalize the RMVS massive body object - deallocates all allocatables + implicit none + ! Arguments + type(rmvs_pl), intent(inout) :: self !! RMVS massive body object + + call self%dealloc() + + return + end subroutine rmvs_final_pl + + + subroutine rmvs_final_system(self) + !! author: David A. Minton + !! + !! Finalize the RMVS nbody system object - deallocates all allocatables + implicit none + ! Arguments + type(rmvs_nbody_system), intent(inout) :: self !! RMVS nbody system object + + if (allocated(self%vbeg)) deallocate(self%vbeg) + call whm_final_system(self%whm_nbody_system) + + return + end subroutine rmvs_final_system + + + subroutine rmvs_final_tp(self) + !! author: David A. Minton + !! + !! Finalize the RMVS test particle object - deallocates all allocatables + implicit none + ! Arguments + type(rmvs_tp), intent(inout) :: self !! RMVS test particle object + + call self%dealloc() + + return + end subroutine rmvs_final_tp + + +end module rmvs diff --git a/src/rmvs/rmvs_setup.f90 b/src/rmvs/rmvs_setup.f90 deleted file mode 100644 index 2c5a0faea..000000000 --- a/src/rmvs/rmvs_setup.f90 +++ /dev/null @@ -1,166 +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. - -submodule(rmvs_classes) s_rmvs_setup - use swiftest -contains - - module subroutine rmvs_setup_pl(self, n, param) - !! author: David A. Minton - !! - !! Allocate RMVS test particle structure - !! - !! Equivalent in functionality to David E. Kaufmann's Swifter routine rmvs_setup.f90 - implicit none - ! Arguments - class(rmvs_pl), intent(inout) :: self !! RMVS 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 - ! Internals - integer(I4B) :: i - - !> Call allocation method for parent class - associate(pl => self) - call whm_setup_pl(pl, n, param) - if (n == 0) return - - allocate(pl%outer(0:NTENC)) - allocate(pl%inner(0:NTPHENC)) - if (.not.pl%lplanetocentric) then - allocate(pl%nenc(n)) - pl%nenc(:) = 0 - ! Set up inner and outer planet interpolation vector storage containers - do i = 0, NTENC - allocate(pl%outer(i)%x(NDIM, n)) - allocate(pl%outer(i)%v(NDIM, n)) - pl%outer(i)%x(:,:) = 0.0_DP - pl%outer(i)%v(:,:) = 0.0_DP - end do - do i = 0, NTPHENC - allocate(pl%inner(i)%x(NDIM, n)) - allocate(pl%inner(i)%v(NDIM, n)) - allocate(pl%inner(i)%aobl(NDIM, n)) - pl%inner(i)%x(:,:) = 0.0_DP - pl%inner(i)%v(:,:) = 0.0_DP - pl%inner(i)%aobl(:,:) = 0.0_DP - end do - ! if (param%ltides) then - ! do i = 0, NTPHENC - ! allocate(pl%inner(i)%atide(NDIM, n)) - ! pl%inner(i)%atide(:,:) = 0.0_DP - ! end do - ! end if - end if - end associate - return - end subroutine rmvs_setup_pl - - - module subroutine rmvs_setup_initialize_system(self, param) - !! author: David A. Minton - !! - !! Initialize an RMVS nbody system from files and sets up the planetocentric structures. - !! - !! We currently rearrange the pl order to keep it consistent with the way Swifter does it - !! In Swifter, the central body occupies the first position in the pl list, and during - !! encounters, the encountering planet is skipped in loops. In Swiftest, we instantiate an - !! RMVS nbody system object attached to each pl to store planetocentric versions of the system - !! to use during close encounters. - implicit none - ! Arguments - class(rmvs_nbody_system), intent(inout) :: self !! RMVS system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i, j - - ! Call parent method - call whm_setup_initialize_system(self, param) - - ! Set up the pl-tp planetocentric encounter structures for pl and cb. The planetocentric tp structures are - ! generated as necessary during close encounter steps. - select type(pl => self%pl) - class is(rmvs_pl) - select type(cb => self%cb) - class is (rmvs_cb) - select type (tp => self%tp) - class is (rmvs_tp) - tp%cb_heliocentric = cb - pl%lplanetocentric = .false. - tp%lplanetocentric = .false. - cb%lplanetocentric = .false. - associate(npl => pl%nbody) - allocate(pl%planetocentric(npl)) - pl%planetocentric(:)%lplanetocentric = .true. - do i = 1, npl - allocate(pl%planetocentric(i)%cb, source=cb) - allocate(rmvs_pl :: pl%planetocentric(i)%pl) - select type(cbenci => pl%planetocentric(i)%cb) - class is (rmvs_cb) - select type(plenci => pl%planetocentric(i)%pl) - class is (rmvs_pl) - cbenci%lplanetocentric = .true. - plenci%lplanetocentric = .true. - call plenci%setup(npl, param) - plenci%status(:) = ACTIVE - plenci%lmask(:) = .true. - ! plind stores the heliocentric index value of a planetocentric planet - ! e.g. Consider an encounter with planet 3. - ! Then the following will be the values of plind: - ! pl%planetocentric(3)%pl%plind(1) = 0 (central body - never used) - ! pl%planetocentric(3)%pl%plind(2) = 1 - ! pl%planetocentric(3)%pl%plind(3) = 2 - ! pl%planetocentric(3)%pl%plind(4) = 4 - ! pl%planetocentric(3)%pl%plind(5) = 5 - ! etc. - allocate(plenci%plind(npl)) - plenci%plind(1:npl) = [(j,j=1,npl)] - plenci%plind(2:npl) = pack(plenci%plind(1:npl), plenci%plind(1:npl) /= i) - plenci%plind(1) = 0 - plenci%Gmass(1) = cb%Gmass - plenci%Gmass(2:npl) = pl%Gmass(plenci%plind(2:npl)) - cbenci%Gmass = pl%Gmass(i) - end select - end select - end do - end associate - end select - end select - end select - return - end subroutine rmvs_setup_initialize_system - - - module subroutine rmvs_setup_tp(self, n, param) - !! author: David A. Minton - !! - !! Allocate WHM test particle structure - !! - !! Equivalent in functionality to David E. Kaufmann's Swifter routine whm_setup.f90 - implicit none - ! Arguments - class(rmvs_tp), intent(inout) :: self !! RMVS 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. In this case, whm does not have its own setup method, so we use the base method for swiftest_tp - call setup_tp(self, n, param) - if (n <= 0) return - - allocate(self%lperi(n)) - allocate(self%plperP(n)) - allocate(self%plencP(n)) - - if (self%lplanetocentric) allocate(self%xheliocentric(NDIM, n)) - - self%lperi(:) = .false. - - return - end subroutine rmvs_setup_tp - -end submodule s_rmvs_setup diff --git a/src/rmvs/rmvs_step.f90 b/src/rmvs/rmvs_step.f90 index 25285899f..1bc313336 100644 --- a/src/rmvs/rmvs_step.f90 +++ b/src/rmvs/rmvs_step.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(rmvs_classes) s_rmvs_step +submodule(rmvs) s_rmvs_step use swiftest contains @@ -26,7 +26,7 @@ module subroutine rmvs_step_system(self, param, t, dt) real(DP), intent(in) :: dt !! Current stepsiz ! Internals logical :: lencounter, lfirstpl - real(DP), dimension(:,:), allocatable :: xbeg, xend, vbeg + real(DP), dimension(:,:), allocatable :: rbeg, rend, vbeg if (self%tp%nbody == 0) then call whm_step_system(self, param, t, dt) @@ -37,32 +37,32 @@ module subroutine rmvs_step_system(self, param, t, dt) class is (rmvs_pl) select type(tp => self%tp) class is (rmvs_tp) - associate(system => self, ntp => tp%nbody, npl => pl%nbody) - allocate(xbeg, source=pl%xh) + associate(nbody_system => self, ntp => tp%nbody, npl => pl%nbody) + allocate(rbeg, source=pl%rh) allocate(vbeg, source=pl%vh) - call pl%set_beg_end(xbeg = xbeg, vbeg = vbeg) + call pl%set_beg_end(rbeg = rbeg, vbeg = vbeg) ! ****** Check for close encounters ***** ! call pl%set_renc(RHSCALE) - lencounter = tp%encounter_check(param, system, dt) + lencounter = tp%encounter_check(param, nbody_system, dt) if (lencounter) then lfirstpl = pl%lfirst - pl%outer(0)%x(:, 1:npl) = xbeg(:, 1:npl) + pl%outer(0)%x(:, 1:npl) = rbeg(:, 1:npl) pl%outer(0)%v(:, 1:npl) = vbeg(:, 1:npl) - call pl%step(system, param, t, dt) - pl%outer(NTENC)%x(:, 1:npl) = pl%xh(:, 1:npl) + call pl%step(nbody_system, param, t, dt) + pl%outer(NTENC)%x(:, 1:npl) = pl%rh(:, 1:npl) pl%outer(NTENC)%v(:, 1:npl) = pl%vh(:, 1:npl) call rmvs_interp_out(cb, pl, dt) - call rmvs_step_out(cb, pl, tp, system, param, t, dt) + call rmvs_step_out(cb, pl, tp, nbody_system, param, t, dt) tp%lmask(1:ntp) = .not. tp%lmask(1:ntp) - call pl%set_beg_end(xbeg = xbeg, xend = xend) + call pl%set_beg_end(rbeg = rbeg, rend = rend) tp%lfirst = .true. - call tp%step(system, param, t, dt) + call tp%step(nbody_system, param, t, dt) tp%lmask(1:ntp) = .true. pl%lfirst = lfirstpl tp%lfirst = .true. - ! if (param%ltides) call system%step_spin(param, t, dt) + ! if (param%ltides) call nbody_system%step_spin(param, t, dt) else - call whm_step_system(system, param, t, dt) + call whm_step_system(nbody_system, param, t, dt) end if end associate end select @@ -96,7 +96,7 @@ subroutine rmvs_interp_out(cb, pl, dt) dntenc = real(NTENC, kind=DP) associate (npl => pl%nbody) - allocate(xtmp, mold = pl%xh) + allocate(xtmp, mold = pl%rh) allocate(vtmp, mold = pl%vh) allocate(GMcb(npl)) allocate(dto(npl)) @@ -106,7 +106,7 @@ subroutine rmvs_interp_out(cb, pl, dt) xtmp(:,1:npl) = pl%outer(0)%x(:, 1:npl) vtmp(:,1:npl) = pl%outer(0)%v(:, 1:npl) do outer_index = 1, NTENC - 1 - call drift_one(GMcb(1:npl), xtmp(1,1:npl), xtmp(2,1:npl), xtmp(3,1:npl), & + call swiftest_drift_one(GMcb(1:npl), xtmp(1,1:npl), xtmp(2,1:npl), xtmp(3,1:npl), & vtmp(1,1:npl), vtmp(2,1:npl), vtmp(3,1:npl), & dto(1:npl), iflag(1:npl)) if (any(iflag(1:npl) /= 0)) then @@ -128,7 +128,7 @@ subroutine rmvs_interp_out(cb, pl, dt) xtmp(:, 1:npl) = pl%outer(NTENC)%x(:, 1:npl) vtmp(:, 1:npl) = pl%outer(NTENC)%v(:, 1:npl) do outer_index = NTENC - 1, 1, -1 - call drift_one(GMcb(1:npl), xtmp(1,1:npl), xtmp(2,1:npl), xtmp(3,1:npl), & + call swiftest_drift_one(GMcb(1:npl), xtmp(1,1:npl), xtmp(2,1:npl), xtmp(3,1:npl), & vtmp(1,1:npl), vtmp(2,1:npl), vtmp(3,1:npl), & -dto(1:npl), iflag(1:npl)) if (any(iflag(1:npl) /= 0)) then @@ -153,7 +153,7 @@ subroutine rmvs_interp_out(cb, pl, dt) end subroutine rmvs_interp_out - subroutine rmvs_step_out(cb, pl, tp, system, param, t, dt) + subroutine rmvs_step_out(cb, pl, tp, nbody_system, param, t, dt) !! author: David A. Minton !! !! Step ACTIVE test particles ahead in the outer encounter region, setting up and calling the inner region @@ -166,7 +166,7 @@ subroutine rmvs_step_out(cb, pl, tp, system, param, t, dt) class(rmvs_cb), intent(inout) :: cb !! RMVS central body object class(rmvs_pl), intent(inout) :: pl !! RMVS massive body object class(rmvs_tp), intent(inout) :: tp !! RMVS test particle object - class(rmvs_nbody_system), intent(inout) :: system !! RMVS nbody system object + class(rmvs_nbody_system), intent(inout) :: nbody_system !! RMVS nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Current stepsiz @@ -185,21 +185,21 @@ subroutine rmvs_step_out(cb, pl, tp, system, param, t, dt) call pl%set_renc(RHPSCALE) do outer_index = 1, NTENC outer_time = t + (outer_index - 1) * dto - call pl%set_beg_end(xbeg = pl%outer(outer_index - 1)%x(:, 1:npl), & + call pl%set_beg_end(rbeg = pl%outer(outer_index - 1)%x(:, 1:npl), & vbeg = pl%outer(outer_index - 1)%v(:, 1:npl), & - xend = pl%outer(outer_index )%x(:, 1:npl)) - lencounter = tp%encounter_check(param, system, dto) + rend = pl%outer(outer_index )%x(:, 1:npl)) + lencounter = tp%encounter_check(param, nbody_system, dto) if (lencounter) then ! Interpolate planets in inner encounter region - call rmvs_interp_in(cb, pl, system, param, dto, outer_index) + call rmvs_interp_in(cb, pl, nbody_system, param, dto, outer_index) ! Step through the inner region call rmvs_step_in(cb, pl, tp, param, outer_time, dto) lfirsttp = tp%lfirst tp%lfirst = .true. - call tp%step(system, param, outer_time, dto) + call tp%step(nbody_system, param, outer_time, dto) tp%lfirst = lfirsttp else - call tp%step(system, param, outer_time, dto) + call tp%step(nbody_system, param, outer_time, dto) end if do j = 1, npl if (pl%nenc(j) == 0) cycle @@ -215,7 +215,7 @@ subroutine rmvs_step_out(cb, pl, tp, system, param, t, dt) end subroutine rmvs_step_out - subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) + subroutine rmvs_interp_in(cb, pl, nbody_system, param, dt, outer_index) !! author: David A. Minton !! !! Interpolate planet positions between two Keplerian orbits in inner encounter regio @@ -227,18 +227,18 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) ! Arguments class(rmvs_cb), intent(inout) :: cb !! RMVS cenral body object class(rmvs_pl), intent(inout) :: pl !! RMVS massive body object - class(rmvs_nbody_system), intent(inout) :: system !! RMVS nbody system object + class(rmvs_nbody_system), intent(inout) :: nbody_system !! RMVS nbody system object class(swiftest_parameters), intent(in) :: param !! Swiftest parameters file real(DP), intent(in) :: dt !! Step size integer(I4B), intent(in) :: outer_index !! Outer substep number within current set ! Internals integer(I4B) :: i, inner_index real(DP) :: frac, dntphenc - real(DP), dimension(:,:), allocatable :: xtmp, vtmp, xh_original, ah_original + real(DP), dimension(:,:), allocatable :: xtmp, vtmp, rh_original, ah_original real(DP), dimension(:), allocatable :: GMcb, dti integer(I4B), dimension(:), allocatable :: iflag - associate (npl => system%pl%nbody) + associate (npl => nbody_system%pl%nbody) dntphenc = real(NTPHENC, kind=DP) ! Set the endpoints of the inner region from the outer region values in the current outer step index @@ -247,7 +247,7 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) pl%inner(NTPHENC)%x(:, 1:npl) = pl%outer(outer_index)%x(:, 1:npl) pl%inner(NTPHENC)%v(:, 1:npl) = pl%outer(outer_index)%v(:, 1:npl) - allocate(xtmp,mold=pl%xh) + allocate(xtmp,mold=pl%rh) allocate(vtmp,mold=pl%vh) allocate(GMcb(npl)) allocate(dti(npl)) @@ -258,22 +258,22 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) vtmp(:, 1:npl) = pl%inner(0)%v(:, 1:npl) if ((param%loblatecb) .or. (param%ltides)) then - allocate(xh_original, source=pl%xh) + allocate(rh_original, source=pl%rh) allocate(ah_original, source=pl%ah) - pl%xh(:, 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(system) + call pl%accel_obl(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 ! if (param%ltides) then - ! call pl%accel_tides(system) + ! call pl%accel_tides(nbody_system) ! pl%inner(0)%atide(:, 1:npl) = pl%atide(:, 1:npl) ! Save the oblateness acceleration on the planet for this substep ! end if do inner_index = 1, NTPHENC - 1 - call drift_one(GMcb(1:npl), xtmp(1,1:npl), xtmp(2,1:npl), xtmp(3,1:npl), & + call swiftest_drift_one(GMcb(1:npl), xtmp(1,1:npl), xtmp(2,1:npl), xtmp(3,1:npl), & vtmp(1,1:npl), vtmp(2,1:npl), vtmp(3,1:npl), & dti(1:npl), iflag(1:npl)) if (any(iflag(1:npl) /= 0)) then @@ -297,7 +297,7 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) vtmp(:, 1:npl) = pl%inner(NTPHENC)%v(:, 1:npl) do inner_index = NTPHENC - 1, 1, -1 - call drift_one(GMcb(1:npl), xtmp(1,1:npl), xtmp(2,1:npl), xtmp(3,1:npl), & + call swiftest_drift_one(GMcb(1:npl), xtmp(1,1:npl), xtmp(2,1:npl), xtmp(3,1:npl), & vtmp(1,1:npl), vtmp(2,1:npl), vtmp(3,1:npl), & -dti(1:npl), iflag(1:npl)) if (any(iflag(1:npl) /= 0)) then @@ -317,29 +317,29 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) pl%inner(inner_index)%v(:, 1:npl) = pl%inner(inner_index)%v(:, 1:npl) + frac * vtmp(:, 1:npl) if (param%loblatecb) then - pl%xh(:,1:npl) = pl%inner(inner_index)%x(:, 1:npl) - call pl%accel_obl(system) + pl%rh(:,1:npl) = pl%inner(inner_index)%x(:, 1:npl) + call pl%accel_obl(nbody_system) pl%inner(inner_index)%aobl(:, 1:npl) = pl%aobl(:, 1:npl) end if ! TODO: Implement tides ! if (param%ltides) then - ! call pl%accel_tides(system) + ! call pl%accel_tides(nbody_system) ! pl%inner(inner_index)%atide(:, 1:npl) = pl%atide(:, 1:npl) ! end if end do if (param%loblatecb) then ! Calculate the final value of oblateness accelerations at the final inner substep - pl%xh(:, 1:npl) = pl%inner(NTPHENC)%x(:, 1:npl) - call pl%accel_obl(system) + pl%rh(:, 1:npl) = pl%inner(NTPHENC)%x(:, 1:npl) + call pl%accel_obl(nbody_system) pl%inner(NTPHENC)%aobl(:, 1:npl) = pl%aobl(:, 1:npl) end if ! TODO: Implement tides ! if (param%ltides) then - ! call pl%accel_tides(system) + ! call pl%accel_tides(nbody_system) ! pl%inner(NTPHENC)%atide(:, 1:npl) = pl%atide(:, 1:npl) ! end if ! Put the planet positions and accelerations back into place - if (allocated(xh_original)) call move_alloc(xh_original, pl%xh) + if (allocated(rh_original)) call move_alloc(rh_original, pl%rh) if (allocated(ah_original)) call move_alloc(ah_original, pl%ah) end associate return @@ -388,9 +388,9 @@ subroutine rmvs_step_in(cb, pl, tp, param, outer_time, dto) ! 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 - plenci%xh(:, 1:npl) = plenci%inner(inner_index - 1)%x(:, 1:npl) - call plenci%set_beg_end(xbeg = plenci%inner(inner_index - 1)%x, & - xend = plenci%inner(inner_index)%x) + 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 cbenci%aoblbeg = cbenci%inner(inner_index - 1)%aobl(:, 1) @@ -403,7 +403,7 @@ subroutine rmvs_step_in(cb, pl, tp, param, outer_time, dto) call tpenci%step(planetocen_system, param, inner_time, dti) do j = 1, pl%nenc(i) - tpenci%xheliocentric(:, j) = tpenci%xh(:, j) + pl%inner(inner_index)%x(:,i) + tpenci%rheliocentric(:, j) = tpenci%rh(:, j) + pl%inner(inner_index)%x(:,i) end do inner_time = outer_time + j * dti call rmvs_peri_tp(tpenci, pl, inner_time, dti, .false., inner_index, i, param) @@ -464,8 +464,8 @@ subroutine rmvs_make_planetocentric(param, cb, pl, tp) ! Grab all the encountering test particles and convert them to a planetocentric frame tpenci%id(1:nenci) = pack(tp%id(1:ntp), encmask(1:ntp)) do j = 1, NDIM - tpenci%xheliocentric(j, 1:nenci) = pack(tp%xh(j,1:ntp), encmask(:)) - tpenci%xh(j, 1:nenci) = tpenci%xheliocentric(j, 1:nenci) - pl%inner(0)%x(j, i) + tpenci%rheliocentric(j, 1:nenci) = pack(tp%rh(j,1:ntp), encmask(:)) + tpenci%rh(j, 1:nenci) = tpenci%rheliocentric(j, 1:nenci) - pl%inner(0)%x(j, i) tpenci%vh(j, 1:nenci) = pack(tp%vh(j, 1:ntp), encmask(1:ntp)) - pl%inner(0)%v(j, i) end do tpenci%lperi(1:nenci) = pack(tp%lperi(1:ntp), encmask(1:ntp)) @@ -534,11 +534,11 @@ subroutine rmvs_peri_tp(tp, pl, t, dt, lfirst, inner_index, ipleP, param) ! Internals integer(I4B) :: i, id1, id2 real(DP) :: r2, mu, rhill2, vdotr, a, peri, capm, tperi, rpl - real(DP), dimension(NDIM) :: xh1, xh2, vh1, vh2 + real(DP), dimension(NDIM) :: rh1, rh2, vh1, vh2 rhill2 = pl%rhill(ipleP)**2 mu = pl%Gmass(ipleP) - associate(nenc => tp%nbody, xpc => tp%xh, vpc => tp%vh) + associate(nenc => tp%nbody, xpc => tp%rh, vpc => tp%vh) if (lfirst) then do i = 1, nenc if (tp%lmask(i)) then @@ -557,21 +557,11 @@ subroutine rmvs_peri_tp(tp, pl, t, dt, lfirst, inner_index, ipleP, param) if (tp%isperi(i) == -1) then if (vdotr >= 0.0_DP) then tp%isperi(i) = 0 - call orbel_xv2aqt(mu, xpc(1,i), xpc(2,i), xpc(3,i), vpc(1,i), vpc(2,i), vpc(3,i), & + call swiftest_orbel_xv2aqt(mu, xpc(1,i), xpc(2,i), xpc(3,i), vpc(1,i), vpc(2,i), vpc(3,i), & a, peri, capm, tperi) r2 = dot_product(xpc(:, i), xpc(:, i)) if ((abs(tperi) > FACQDT * dt) .or. (r2 > rhill2)) peri = sqrt(r2) - if (param%enc_out /= "") then - id1 = pl%id(ipleP) - rpl = pl%radius(ipleP) - xh1(:) = pl%inner(inner_index)%x(:, ipleP) - vh1(:) = pl%inner(inner_index)%v(:, ipleP) - id2 = tp%id(i) - xh2(:) = xpc(:, i) + xh1(:) - vh2(:) = xpc(:, i) + vh1(:) - call rmvs_io_write_encounter(t, id1, id2, mu, 0.0_DP, rpl, 0.0_DP, & - xh1(:), xh2(:), vh1(:), vh2(:), param%enc_out) - end if + ! TODO: write NetCDF encounter output writer if (tp%lperi(i)) then if (peri < tp%peri(i)) then tp%peri(i) = peri @@ -635,7 +625,7 @@ subroutine rmvs_end_planetocentric(pl, tp) tp%status(tpind(1:nenci)) = tpenci%status(1:nenci) tp%lmask(tpind(1:nenci)) = tpenci%lmask(1:nenci) do j = 1, NDIM - tp%xh(j, tpind(1:nenci)) = tpenci%xh(j,1:nenci) + pl%inner(NTPHENC)%x(j, i) + tp%rh(j, tpind(1:nenci)) = tpenci%rh(j,1:nenci) + pl%inner(NTPHENC)%x(j, i) tp%vh(j, tpind(1:nenci)) = tpenci%vh(j,1:nenci) + pl%inner(NTPHENC)%v(j, i) end do tp%lperi(tpind(1:nenci)) = tpenci%lperi(1:nenci) diff --git a/src/rmvs/rmvs_util.f90 b/src/rmvs/rmvs_util.f90 index 0fc1ed272..07e4f9a51 100644 --- a/src/rmvs/rmvs_util.f90 +++ b/src/rmvs/rmvs_util.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(rmvs_classes) s_rmvs_util +submodule(rmvs) s_rmvs_util use swiftest contains @@ -25,15 +25,15 @@ module subroutine rmvs_util_append_pl(self, source, lsource_mask) select type(source) class is (rmvs_pl) associate(nold => self%nbody, nsrc => source%nbody) - call util_append(self%nenc, source%nenc, nold, nsrc, lsource_mask) - call util_append(self%tpenc1P, source%tpenc1P, nold, nsrc, lsource_mask) - call util_append(self%plind, source%plind, nold, nsrc, lsource_mask) + call swiftest_util_append(self%nenc, source%nenc, nold, nsrc, lsource_mask) + call swiftest_util_append(self%tpenc1P, source%tpenc1P, nold, nsrc, lsource_mask) + call swiftest_util_append(self%plind, source%plind, nold, nsrc, lsource_mask) ! The following are not implemented as RMVS doesn't make use of fill operations on pl type ! So they are here as a placeholder in case someone wants to extend the RMVS class for some reason - !call util_append(self%outer, source%outer, nold, nsrc, lsource_mask) - !call util_append(self%inner, source%inner, nold, nsrc, lsource_mask) - !call util_append(self%planetocentric, source%planetocentric, nold, nsrc, lsource_mask) + !call swiftest_util_append(self%outer, source%outer, nold, nsrc, lsource_mask) + !call swiftest_util_append(self%inner, source%inner, nold, nsrc, lsource_mask) + !call swiftest_util_append(self%planetocentric, source%planetocentric, nold, nsrc, lsource_mask) call whm_util_append_pl(self, source, lsource_mask) end associate @@ -60,11 +60,11 @@ module subroutine rmvs_util_append_tp(self, source, lsource_mask) select type(source) class is (rmvs_tp) associate(nold => self%nbody, nsrc => source%nbody) - call util_append(self%lperi, source%lperi, nold, nsrc, lsource_mask) - call util_append(self%plperP, source%plperP, nold, nsrc, lsource_mask) - call util_append(self%plencP, source%plencP, nold, nsrc, lsource_mask) + call swiftest_util_append(self%lperi, source%lperi, nold, nsrc, lsource_mask) + call swiftest_util_append(self%plperP, source%plperP, nold, nsrc, lsource_mask) + call swiftest_util_append(self%plencP, source%plencP, nold, nsrc, lsource_mask) - call util_append_tp(self, source, lsource_mask) ! Note: whm_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) ! Note: whm_tp does not have its own append method, so we skip back to the base class end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class rmvs_tp or its descendents!" @@ -96,7 +96,7 @@ module subroutine rmvs_util_dealloc_interp(self) !! Deallocates all allocatabale arrays implicit none ! Argument - class(rmvs_interp), intent(inout) :: self !! RMVS interpolated system variables object + class(rmvs_interp), intent(inout) :: self !! RMVS interpolated nbody_system variables object if (allocated(self%x)) deallocate(self%x) if (allocated(self%v)) deallocate(self%v) @@ -137,10 +137,10 @@ module subroutine rmvs_util_dealloc_tp(self) if (allocated(self%lperi)) deallocate(self%lperi) if (allocated(self%plperP)) deallocate(self%plperP) if (allocated(self%plencP)) deallocate(self%plencP) - if (allocated(self%xheliocentric)) deallocate(self%xheliocentric) + if (allocated(self%rheliocentric)) deallocate(self%rheliocentric) call self%cb_heliocentric%dealloc() - call util_dealloc_tp(self) + call swiftest_util_dealloc_tp(self) return end subroutine rmvs_util_dealloc_tp @@ -161,15 +161,15 @@ module subroutine rmvs_util_fill_pl(self, inserts, lfill_list) associate(keeps => self) select type(inserts) class is (rmvs_pl) - call util_fill(keeps%nenc, inserts%nenc, lfill_list) - call util_fill(keeps%tpenc1P, inserts%tpenc1P, lfill_list) - call util_fill(keeps%plind, inserts%plind, lfill_list) + call swiftest_util_fill(keeps%nenc, inserts%nenc, lfill_list) + call swiftest_util_fill(keeps%tpenc1P, inserts%tpenc1P, lfill_list) + call swiftest_util_fill(keeps%plind, inserts%plind, lfill_list) ! The following are not implemented as RMVS doesn't make use of fill operations on pl type ! So they are here as a placeholder in case someone wants to extend the RMVS class for some reason - !call util_fill(keeps%outer, inserts%outer, lfill_list) - !call util_fill(keeps%inner, inserts%inner, lfill_list) - !call util_fill(keeps%planetocentric, inserts%planetocentric, lfill_list) + !call swiftest_util_fill(keeps%outer, inserts%outer, lfill_list) + !call swiftest_util_fill(keeps%inner, inserts%inner, lfill_list) + !call swiftest_util_fill(keeps%planetocentric, inserts%planetocentric, lfill_list) call whm_util_fill_pl(keeps, inserts, lfill_list) class default @@ -181,77 +181,7 @@ module subroutine rmvs_util_fill_pl(self, inserts, lfill_list) return end subroutine rmvs_util_fill_pl - - module subroutine rmvs_util_final_cb(self) - !! author: David A. Minton - !! - !! Finalize the RMVS massive body object - deallocates all allocatables - implicit none - ! Arguments - type(rmvs_cb), intent(inout) :: self !! RMVS central body object - - call self%dealloc() - - return - end subroutine rmvs_util_final_cb - - - module subroutine rmvs_util_final_interp(self) - !! author: David A. Minton - !! - !! Finalize the RMVS nbody system object - deallocates all allocatables - implicit none - ! Arguments - type(rmvs_interp), intent(inout) :: self !! RMVS nbody system object - - call self%dealloc() - - return - end subroutine rmvs_util_final_interp - - - module subroutine rmvs_util_final_pl(self) - !! author: David A. Minton - !! - !! Finalize the RMVS massive body object - deallocates all allocatables - implicit none - ! Arguments - type(rmvs_pl), intent(inout) :: self !! RMVS massive body object - - call self%dealloc() - - return - end subroutine rmvs_util_final_pl - - - module subroutine rmvs_util_final_system(self) - !! author: David A. Minton - !! - !! Finalize the RMVS nbody system object - deallocates all allocatables - implicit none - ! Arguments - type(rmvs_nbody_system), intent(inout) :: self !! RMVS nbody system object - - call self%dealloc() - - return - end subroutine rmvs_util_final_system - - - module subroutine rmvs_util_final_tp(self) - !! author: David A. Minton - !! - !! Finalize the RMVS test particle object - deallocates all allocatables - implicit none - ! Arguments - type(rmvs_tp), intent(inout) :: self !! RMVS test particle object - - call self%dealloc() - - return - end subroutine rmvs_util_final_tp - - + module subroutine rmvs_util_fill_tp(self, inserts, lfill_list) !! author: David A. Minton !! @@ -267,11 +197,11 @@ module subroutine rmvs_util_fill_tp(self, inserts, lfill_list) associate(keeps => self) select type(inserts) class is (rmvs_tp) - call util_fill(keeps%lperi, inserts%lperi, lfill_list) - call util_fill(keeps%plperP, inserts%plperP, lfill_list) - call util_fill(keeps%plencP, inserts%plencP, lfill_list) + call swiftest_util_fill(keeps%lperi, inserts%lperi, lfill_list) + call swiftest_util_fill(keeps%plperP, inserts%plperP, lfill_list) + call swiftest_util_fill(keeps%plencP, inserts%plencP, lfill_list) - call util_fill_tp(keeps, inserts, lfill_list) ! Note: whm_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) ! Note: whm_tp does not have its own fill method, so we skip back to the base class class default write(*,*) "Invalid object passed to the fill method. Source must be of class rmvs_tp or its descendents!" call util_exit(FAILURE) @@ -291,15 +221,15 @@ module subroutine rmvs_util_resize_pl(self, nnew) class(rmvs_pl), intent(inout) :: self !! RMVS massive body object integer(I4B), intent(in) :: nnew !! New size neded - call util_resize(self%nenc, nnew) - call util_resize(self%tpenc1P, nnew) - call util_resize(self%plind, nnew) + call swiftest_util_resize(self%nenc, nnew) + call swiftest_util_resize(self%tpenc1P, nnew) + call swiftest_util_resize(self%plind, nnew) ! The following are not implemented as RMVS doesn't make use of resize operations on pl type ! So they are here as a placeholder in case someone wants to extend the RMVS class for some reason - !call util_resize(self%outer, nnew) - !call util_resize(self%inner, nnew) - !call util_resize(self%planetocentric, nnew) + !call swiftest_util_resize(self%outer, nnew) + !call swiftest_util_resize(self%inner, nnew) + !call swiftest_util_resize(self%planetocentric, nnew) call whm_util_resize_pl(self, nnew) return @@ -315,17 +245,170 @@ module subroutine rmvs_util_resize_tp(self, nnew) class(rmvs_tp), intent(inout) :: self !! RMVS test particle object integer(I4B), intent(in) :: nnew !! New size neded - call util_resize(self%lperi, nnew) - call util_resize(self%plperP, nnew) - call util_resize(self%plencP, nnew) - call util_resize(self%xheliocentric, nnew) + call swiftest_util_resize(self%lperi, nnew) + call swiftest_util_resize(self%plperP, nnew) + call swiftest_util_resize(self%plencP, nnew) + call swiftest_util_resize(self%rheliocentric, nnew) - call util_resize_tp(self, nnew) + call swiftest_util_resize_tp(self, nnew) return end subroutine rmvs_util_resize_tp + module subroutine rmvs_util_setup_pl(self, n, param) + !! author: David A. Minton + !! + !! Allocate RMVS test particle structure + !! + !! Equivalent in functionality to David E. Kaufmann's Swifter routine rmvs_util_setup.f90 + implicit none + ! Arguments + class(rmvs_pl), intent(inout) :: self !! RMVS 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 + ! Internals + integer(I4B) :: i + + !> Call allocation method for parent class + associate(pl => self) + call whm_util_setup_pl(pl, n, param) + if (n == 0) return + + allocate(pl%outer(0:NTENC)) + allocate(pl%inner(0:NTPHENC)) + if (.not.pl%lplanetocentric) then + allocate(pl%nenc(n)) + pl%nenc(:) = 0 + ! Set up inner and outer planet interpolation vector storage containers + do i = 0, NTENC + allocate(pl%outer(i)%x(NDIM, n)) + allocate(pl%outer(i)%v(NDIM, n)) + pl%outer(i)%x(:,:) = 0.0_DP + pl%outer(i)%v(:,:) = 0.0_DP + end do + do i = 0, NTPHENC + allocate(pl%inner(i)%x(NDIM, n)) + allocate(pl%inner(i)%v(NDIM, n)) + allocate(pl%inner(i)%aobl(NDIM, n)) + pl%inner(i)%x(:,:) = 0.0_DP + pl%inner(i)%v(:,:) = 0.0_DP + pl%inner(i)%aobl(:,:) = 0.0_DP + end do + ! if (param%ltides) then + ! do i = 0, NTPHENC + ! allocate(pl%inner(i)%atide(NDIM, n)) + ! pl%inner(i)%atide(:,:) = 0.0_DP + ! end do + ! end if + end if + end associate + return + end subroutine rmvs_util_setup_pl + + + module subroutine rmvs_util_setup_initialize_system(self, param) + !! author: David A. Minton + !! + !! Initialize an RMVS nbody system from files and sets up the planetocentric structures. + !! + !! We currently rearrange the pl order to keep it consistent with the way Swifter does it + !! In Swifter, the central body occupies the first position in the pl list, and during + !! encounters, the encountering planet is skipped in loops. In Swiftest, we instantiate an + !! RMVS nbody system object attached to each pl to store planetocentric versions of the nbody_system + !! to use during close encounters. + implicit none + ! Arguments + class(rmvs_nbody_system), intent(inout) :: self !! RMVS system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i, j + + ! Call parent method + call whm_util_setup_initialize_system(self, param) + + ! Set up the pl-tp planetocentric encounter structures for pl and cb. The planetocentric tp structures are + ! generated as necessary during close encounter steps. + select type(pl => self%pl) + class is(rmvs_pl) + select type(cb => self%cb) + class is (rmvs_cb) + select type (tp => self%tp) + class is (rmvs_tp) + tp%cb_heliocentric = cb + pl%lplanetocentric = .false. + tp%lplanetocentric = .false. + cb%lplanetocentric = .false. + associate(npl => pl%nbody) + allocate(pl%planetocentric(npl)) + pl%planetocentric(:)%lplanetocentric = .true. + do i = 1, npl + allocate(pl%planetocentric(i)%cb, source=cb) + allocate(rmvs_pl :: pl%planetocentric(i)%pl) + select type(cbenci => pl%planetocentric(i)%cb) + class is (rmvs_cb) + select type(plenci => pl%planetocentric(i)%pl) + class is (rmvs_pl) + cbenci%lplanetocentric = .true. + plenci%lplanetocentric = .true. + call plenci%setup(npl, param) + plenci%status(:) = ACTIVE + plenci%lmask(:) = .true. + ! plind stores the heliocentric index value of a planetocentric planet + ! e.g. Consider an encounter with planet 3. + ! Then the following will be the values of plind: + ! pl%planetocentric(3)%pl%plind(1) = 0 (central body - never used) + ! pl%planetocentric(3)%pl%plind(2) = 1 + ! pl%planetocentric(3)%pl%plind(3) = 2 + ! pl%planetocentric(3)%pl%plind(4) = 4 + ! pl%planetocentric(3)%pl%plind(5) = 5 + ! etc. + allocate(plenci%plind(npl)) + plenci%plind(1:npl) = [(j,j=1,npl)] + plenci%plind(2:npl) = pack(plenci%plind(1:npl), plenci%plind(1:npl) /= i) + plenci%plind(1) = 0 + plenci%Gmass(1) = cb%Gmass + plenci%Gmass(2:npl) = pl%Gmass(plenci%plind(2:npl)) + cbenci%Gmass = pl%Gmass(i) + end select + end select + end do + end associate + end select + end select + end select + return + end subroutine rmvs_util_setup_initialize_system + + + module subroutine rmvs_util_setup_tp(self, n, param) + !! author: David A. Minton + !! + !! Allocate WHM test particle structure + !! + !! Equivalent in functionality to David E. Kaufmann's Swifter routine whm_util_setup.f90 + implicit none + ! Arguments + class(rmvs_tp), intent(inout) :: self !! RMVS 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%whm_tp%setup(n, param) + if (n <= 0) return + + allocate(self%lperi(n)) + allocate(self%plperP(n)) + allocate(self%plencP(n)) + + if (self%lplanetocentric) allocate(self%rheliocentric(NDIM, n)) + + self%lperi(:) = .false. + + return + end subroutine rmvs_util_setup_tp + + module subroutine rmvs_util_sort_pl(self, sortby, ascending) !! author: David A. Minton !! @@ -351,11 +434,11 @@ module subroutine rmvs_util_sort_pl(self, sortby, ascending) associate(pl => self, npl => self%nbody) select case(sortby) case("nenc") - call util_sort(direction * pl%nenc(1:npl), ind) + call swiftest_util_sort(direction * pl%nenc(1:npl), ind) case("tpenc1P") - call util_sort(direction * pl%tpenc1P(1:npl), ind) + call swiftest_util_sort(direction * pl%tpenc1P(1:npl), ind) case("plind") - call util_sort(direction * pl%plind(1:npl), ind) + call swiftest_util_sort(direction * pl%plind(1:npl), ind) case("outer", "inner", "planetocentric", "lplanetocentric") write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' case default ! Look for components in the parent class @@ -395,13 +478,13 @@ module subroutine rmvs_util_sort_tp(self, sortby, ascending) associate(tp => self, ntp => self%nbody) select case(sortby) case("plperP") - call util_sort(direction * tp%plperP(1:ntp), ind) + call swiftest_util_sort(direction * tp%plperP(1:ntp), ind) case("plencP") - call util_sort(direction * tp%plencP(1:ntp), ind) - case("lperi", "cb_heliocentric", "xheliocentric", "index", "ipleP", "lplanetocentric") + call swiftest_util_sort(direction * tp%plencP(1:ntp), ind) + case("lperi", "cb_heliocentric", "rheliocentric", "index", "ipleP", "lplanetocentric") write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' case default ! Look for components in the parent class (*NOTE whm_tp does not need its own sort method, so we go straight to the swiftest_tp method) - call util_sort_tp(tp, sortby, ascending) + call swiftest_util_sort_tp(tp, sortby, ascending) return end select @@ -424,10 +507,10 @@ module subroutine rmvs_util_sort_rearrange_pl(self, ind) if (self%nbody == 0) return associate(pl => self, npl => self%nbody) - call util_sort_rearrange(pl%nenc, ind, npl) - call util_sort_rearrange(pl%tpenc1P, ind, npl) - call util_sort_rearrange(pl%plind, ind, npl) - call util_sort_rearrange_pl(pl,ind) + call swiftest_util_sort_rearrange(pl%nenc, ind, npl) + call swiftest_util_sort_rearrange(pl%tpenc1P, ind, npl) + call swiftest_util_sort_rearrange(pl%plind, ind, npl) + call swiftest_util_sort_rearrange_pl(pl,ind) end associate return @@ -447,11 +530,11 @@ module subroutine rmvs_util_sort_rearrange_tp(self, ind) if (self%nbody == 0) return associate(tp => self, ntp => self%nbody) - call util_sort_rearrange(tp%lperi, ind, ntp) - call util_sort_rearrange(tp%plperP, ind, ntp) - call util_sort_rearrange(tp%plencP, ind, ntp) - call util_sort_rearrange(tp%xheliocentric, ind, ntp) - call util_sort_rearrange_tp(tp,ind) + call swiftest_util_sort_rearrange(tp%lperi, ind, ntp) + call swiftest_util_sort_rearrange(tp%plperP, ind, ntp) + call swiftest_util_sort_rearrange(tp%plencP, ind, ntp) + call swiftest_util_sort_rearrange(tp%rheliocentric, ind, ntp) + call swiftest_util_sort_rearrange_tp(tp,ind) end associate return @@ -474,9 +557,9 @@ module subroutine rmvs_util_spill_pl(self, discards, lspill_list, ldestructive) associate(keeps => self) select type(discards) class is (rmvs_pl) - call util_spill(keeps%nenc, discards%nenc, lspill_list, ldestructive) - call util_spill(keeps%tpenc1P, discards%tpenc1P, lspill_list, ldestructive) - call util_spill(keeps%plind, discards%plind, lspill_list, ldestructive) + call swiftest_util_spill(keeps%nenc, discards%nenc, lspill_list, ldestructive) + call swiftest_util_spill(keeps%tpenc1P, discards%tpenc1P, lspill_list, ldestructive) + call swiftest_util_spill(keeps%plind, discards%plind, lspill_list, ldestructive) call whm_util_spill_pl(keeps, discards, lspill_list, ldestructive) class default @@ -505,11 +588,11 @@ module subroutine rmvs_util_spill_tp(self, discards, lspill_list, ldestructive) associate(keeps => self) select type(discards) class is (rmvs_tp) - call util_spill(keeps%lperi, discards%lperi, lspill_list, ldestructive) - call util_spill(keeps%plperP, discards%plperP, lspill_list, ldestructive) - call util_spill(keeps%plencP, discards%plencP, lspill_list, ldestructive) + call swiftest_util_spill(keeps%lperi, discards%lperi, lspill_list, ldestructive) + call swiftest_util_spill(keeps%plperP, discards%plperP, lspill_list, ldestructive) + call swiftest_util_spill(keeps%plencP, discards%plencP, lspill_list, ldestructive) - call util_spill_tp(keeps, discards, lspill_list, ldestructive) + call swiftest_util_spill_tp(keeps, discards, lspill_list, ldestructive) class default write(*,*) "Invalid object passed to the spill method. Source must be of class rmvs_tp or its descendents!" call util_exit(FAILURE) diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 deleted file mode 100644 index 859e8c6ba..000000000 --- a/src/setup/setup.f90 +++ /dev/null @@ -1,333 +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. - -submodule (swiftest_classes) s_setup - use swiftest -contains - - module subroutine setup_construct_system(system, param) - !! author: David A. Minton - !! - !! Constructor for a Swiftest nbody system. Creates the nbody system object based on the user-input integrator - !! - implicit none - ! Arguments - class(swiftest_nbody_system), allocatable, intent(inout) :: system !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Swiftest parameters - - select case(param%integrator) - case (BS) - write(*,*) 'Bulirsch-Stoer integrator not yet enabled' - case (HELIO) - allocate(helio_nbody_system :: system) - select type(system) - class is (helio_nbody_system) - allocate(helio_cb :: system%cb) - allocate(helio_pl :: system%pl) - allocate(helio_tp :: system%tp) - allocate(helio_tp :: system%tp_discards) - end select - case (RA15) - write(*,*) 'Radau integrator not yet enabled' - case (TU4) - write(*,*) 'TU4 integrator not yet enabled' - case (WHM) - allocate(whm_nbody_system :: system) - select type(system) - class is (whm_nbody_system) - allocate(whm_cb :: system%cb) - allocate(whm_pl :: system%pl) - allocate(whm_tp :: system%tp) - allocate(whm_tp :: system%tp_discards) - end select - case (RMVS) - allocate(rmvs_nbody_system :: system) - select type(system) - class is (rmvs_nbody_system) - allocate(rmvs_cb :: system%cb) - allocate(rmvs_pl :: system%pl) - allocate(rmvs_tp :: system%tp) - allocate(rmvs_tp :: system%tp_discards) - end select - case (SYMBA) - allocate(symba_nbody_system :: system) - select type(system) - class is (symba_nbody_system) - allocate(symba_cb :: system%cb) - allocate(symba_pl :: system%pl) - allocate(symba_tp :: system%tp) - allocate(symba_tp :: system%tp_discards) - allocate(symba_merger :: system%pl_adds) - allocate(symba_merger :: system%pl_discards) - allocate(symba_pltpenc :: system%pltpenc_list) - allocate(symba_plplenc :: system%plplenc_list) - allocate(symba_plplenc :: system%plplcollision_list) - end select - case (RINGMOONS) - write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' - case default - write(*,*) 'Unkown integrator',param%integrator - call util_exit(FAILURE) - end select - - return - end subroutine setup_construct_system - - - module subroutine setup_finalize_system(self, param) - !! author: David A. Minton - !! - !! Runs any finalization subroutines when ending the simulation. - !! - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - - associate(system => self) - if ((param%out_type == NETCDF_FLOAT_TYPE) .or. (param%out_type == NETCDF_DOUBLE_TYPE)) then - call param%nciu%close() - end if - end associate - - return - end subroutine setup_finalize_system - - - module subroutine setup_initialize_particle_info_system(self, param) - !! author: David A. Minton - !! - !! Setup up particle information metadata from initial conditions - ! - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i - - associate(cb => self%cb, pl => self%pl, npl => self%pl%nbody, tp => self%tp, ntp => self%tp%nbody) - - call cb%info%set_value(particle_type=CB_TYPE_NAME, status="ACTIVE", origin_type="Initial conditions", & - origin_time=param%t0, origin_xh=[0.0_DP, 0.0_DP, 0.0_DP], origin_vh=[0.0_DP, 0.0_DP, 0.0_DP]) - do i = 1, self%pl%nbody - call pl%info(i)%set_value(particle_type=PL_TYPE_NAME, status="ACTIVE", origin_type="Initial conditions", & - origin_time=param%t0, origin_xh=self%pl%xh(:,i), origin_vh=self%pl%vh(:,i)) - end do - do i = 1, self%tp%nbody - call tp%info(i)%set_value(particle_type=TP_TYPE_NAME, status="ACTIVE", origin_type="Initial conditions", & - origin_time=param%t0, origin_xh=self%tp%xh(:,i), origin_vh=self%tp%vh(:,i)) - end do - - end associate - - return - end subroutine setup_initialize_particle_info_system - - - module subroutine setup_initialize_system(self, param) - !! author: David A. Minton - !! - !! Wrapper method to initialize a basic Swiftest nbody system from files - !! - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - - associate(system => self, cb => self%cb, pl => self%pl, tp => self%tp) - - call system%read_in(param) - call system%validate_ids(param) - call system%set_msys() - call pl%set_mu(cb) - call tp%set_mu(cb) - if (param%in_form == EL) then - call pl%el2xv(cb) - call tp%el2xv(cb) - end if - call pl%flatten(param) - if (.not.param%lrhill_present) call pl%set_rhill(cb) - pl%lfirst = param%lfirstkick - tp%lfirst = param%lfirstkick - - if (param%lrestart) then - call system%read_particle_info(param) - else - call system%init_particle_info(param) - end if - end associate - - return - end subroutine setup_initialize_system - - - module subroutine setup_body(self, n, param) - !! author: David A. Minton - !! - !! Constructor for base Swiftest particle class. Allocates space for all particles and - !! initializes all components with a value. - !! Note: Timing tests indicate that (NDIM, n) is more efficient than (NDIM, n) - implicit none - ! Arguments - class(swiftest_body), intent(inout) :: self !! Swiftest generic body object - integer(I4B), intent(in) :: n !! Number of particles to allocate space for - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter - ! Internals - integer(I4B) :: i - - if (n < 0) return - - self%lfirst = .true. - - call self%dealloc() - - self%nbody = n - if (n == 0) return - - allocate(self%info(n)) - allocate(self%id(n)) - allocate(self%status(n)) - allocate(self%ldiscard(n)) - allocate(self%lmask(n)) - allocate(self%mu(n)) - allocate(self%xh(NDIM, n)) - allocate(self%vh(NDIM, n)) - allocate(self%xb(NDIM, n)) - allocate(self%vb(NDIM, n)) - allocate(self%ah(NDIM, n)) - allocate(self%ir3h(n)) - allocate(self%aobl(NDIM, n)) - - self%id(:) = 0 - do i = 1, n - call self%info(i)%set_value(& - name = "UNNAMED", & - particle_type = "UNKNOWN", & - status = "INACTIVE", & - origin_type = "UNKNOWN", & - collision_id = 0, & - origin_time = -huge(1.0_DP), & - origin_xh = [0.0_DP, 0.0_DP, 0.0_DP], & - origin_vh = [0.0_DP, 0.0_DP, 0.0_DP], & - discard_time = -huge(1.0_DP), & - discard_xh = [0.0_DP, 0.0_DP, 0.0_DP], & - discard_vh = [0.0_DP, 0.0_DP, 0.0_DP], & - discard_body_id = -1 & - ) - end do - - self%status(:) = INACTIVE - self%ldiscard(:) = .false. - self%lmask(:) = .false. - self%mu(:) = 0.0_DP - self%xh(:,:) = 0.0_DP - self%vh(:,:) = 0.0_DP - self%xb(:,:) = 0.0_DP - self%vb(:,:) = 0.0_DP - self%ah(:,:) = 0.0_DP - self%ir3h(:) = 0.0_DP - self%aobl(:,:) = 0.0_DP - - if (param%ltides) then - allocate(self%atide(NDIM, n)) - self%atide(:,:) = 0.0_DP - end if - if (param%lgr) then - allocate(self%agr(NDIM, n)) - self%agr(:,:) = 0.0_DP - end if - - return - end subroutine setup_body - - - module subroutine setup_pl(self, n, param) - !! author: David A. Minton - !! - !! Constructor for base Swiftest massive body class. Allocates space for all particles and - !! initializes all components with a value. - implicit none - ! Arguments - 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 parameter - - !> Call allocation method for parent class - !> The parent class here is the abstract swiftest_body class, so we can't use the type-bound procedure - call setup_body(self, n, param) - if (n == 0) return - - allocate(self%mass(n)) - allocate(self%Gmass(n)) - allocate(self%rhill(n)) - allocate(self%renc(n)) - - self%mass(:) = 0.0_DP - self%Gmass(:) = 0.0_DP - self%rhill(:) = 0.0_DP - self%renc(:) = 0.0_DP - - self%nplpl = 0 - - if (param%lclose) then - allocate(self%radius(n)) - allocate(self%density(n)) - self%radius(:) = 0.0_DP - self%density(:) = 1.0_DP - end if - - if (param%lrotation) then - allocate(self%rot(NDIM, n)) - allocate(self%Ip(NDIM, n)) - self%rot(:,:) = 0.0_DP - self%Ip(:,:) = 0.0_DP - end if - - if (param%ltides) then - allocate(self%k2(n)) - allocate(self%Q(n)) - allocate(self%tlag(n)) - self%k2(:) = 0.0_DP - self%Q(:) = 0.0_DP - self%tlag(:) = 0.0_DP - end if - - return - end subroutine setup_pl - - - module subroutine setup_tp(self, n, param) - !! author: David A. Minton - !! - !! Constructor for base Swiftest test particle particle class. Allocates space for - !! all particles and initializes all components with a value. - implicit none - ! Arguments - 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 parameter - - !> Call allocation method for parent class - !> The parent class here is the abstract swiftest_body class, so we can't use the type-bound procedure - call setup_body(self, n, param) - if (n == 0) return - - allocate(self%isperi(n)) - allocate(self%peri(n)) - allocate(self%atp(n)) - - self%isperi(:) = 0 - self%peri(:) = 0.0_DP - self%atp(:) = 0.0_DP - - return - end subroutine setup_tp - -end submodule s_setup diff --git a/src/discard/discard.f90 b/src/swiftest/swiftest_discard.f90 similarity index 77% rename from src/discard/discard.f90 rename to src/swiftest/swiftest_discard.f90 index ffaba5dd6..c9c6df340 100644 --- a/src/discard/discard.f90 +++ b/src/swiftest/swiftest_discard.f90 @@ -7,18 +7,17 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (swiftest_classes) s_discard - use swiftest +submodule (swiftest) s_swiftest_discard contains - module subroutine discard_system(self, param) + module subroutine swiftest_discard_system(self, param) !! author: David A. Minton !! !! Calls the discard methods for each body class and then the write method if any discards were detected !! implicit none ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals logical :: lpl_discards, ltp_discards, lpl_check, ltp_check @@ -26,20 +25,20 @@ module subroutine discard_system(self, param) lpl_check = allocated(self%pl_discards) ltp_check = allocated(self%tp_discards) - associate(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) lpl_discards = .false. ltp_discards = .false. if (lpl_check) then - call pl%discard(system, param) + call pl%discard(nbody_system, param) lpl_discards = (pl_discards%nbody > 0) end if if (ltp_check) then - call tp%discard(system, param) + call tp%discard(nbody_system, param) ltp_discards = (tp_discards%nbody > 0) end if - - if (lpl_discards .or. ltp_discards) call system%write_discard(param) + if (ltp_discards) call tp_discards%write_info(param%system_history%nc, param) + if (lpl_discards) call pl_discards%write_info(param%system_history%nc, param) if (lpl_discards .and. param%lenergy) call self%conservation_report(param, lterminal=.false.) if (lpl_check) call pl_discards%setup(0,param) if (ltp_check) call tp_discards%setup(0,param) @@ -47,10 +46,10 @@ module subroutine discard_system(self, param) end associate return - end subroutine discard_system + end subroutine swiftest_discard_system - module subroutine discard_pl(self, system, param) + 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. @@ -58,17 +57,17 @@ module subroutine discard_pl(self, system, param) implicit none ! Arguments class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameter if (self%nbody == 0) return self%ldiscard(1:self%nbody) = .false. return - end subroutine discard_pl + end subroutine swiftest_discard_pl - module subroutine discard_tp(self, system, param) + module subroutine swiftest_discard_tp(self, nbody_system, param) !! author: David A. Minton !! !! Check to see if particles should be discarded based on their positions relative to the massive bodies @@ -78,13 +77,13 @@ module subroutine discard_tp(self, system, param) implicit none ! Arguments class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system 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 - associate(tp => self, cb => system%cb, pl => system%pl) + associate(tp => self, cb => nbody_system%cb, pl => nbody_system%pl) ntp = tp%nbody npl = pl%nbody @@ -94,77 +93,77 @@ module subroutine discard_tp(self, 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 discard_cb_tp(tp, system, param) - if (param%qmin >= 0.0_DP) call discard_peri_tp(tp, system, param) - if (param%lclose) call discard_pl_tp(tp, system, param) + 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(system%tp_discards, ldiscard(1:ntp), ldestructive=.true.) + call tp%spill(nbody_system%tp_discards, ldiscard(1:ntp), ldestructive=.true.) end if end associate return - end subroutine discard_tp + end subroutine swiftest_discard_tp - subroutine discard_cb_tp(tp, system, param) + subroutine swiftest_discard_cb_tp(tp, nbody_system, param) !! author: David A. Minton !! !! Check to see if test particles should be discarded based on their positions relative to the Sun - !! or because they are unbound from the system + !! or because they are unbound from the nbody_system !! !! Adapted from David E. Kaufmann's Swifter routine: discard_sun.f90 !! Adapted from Hal Levison's Swift routine discard_sun.f implicit none ! Arguments class(swiftest_tp), intent(inout) :: tp !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i real(DP) :: energy, vb2, rb2, rh2, rmin2, rmax2, rmaxu2 character(len=STRMAX) :: idstr, timestr - associate(ntp => tp%nbody, cb => system%cb, Gmtot => system%Gmtot) + associate(ntp => tp%nbody, cb => nbody_system%cb, Gmtot => nbody_system%Gmtot) rmin2 = max(param%rmin * param%rmin, cb%radius * cb%radius) rmax2 = param%rmax**2 rmaxu2 = param%rmaxu**2 do i = 1, ntp if (tp%status(i) == ACTIVE) then - rh2 = dot_product(tp%xh(:, i), tp%xh(:, i)) + rh2 = dot_product(tp%rh(:, i), tp%rh(:, i)) if ((param%rmax >= 0.0_DP) .and. (rh2 > rmax2)) then tp%status(i) = DISCARDED_RMAX write(idstr, *) tp%id(i) - write(timestr, *) param%t + write(timestr, *) nbody_system%t write(*, *) "Particle " // trim(adjustl(tp%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " too far from the central body at t = " // trim(adjustl(timestr)) tp%ldiscard(i) = .true. tp%lmask(i) = .false. - call tp%info(i)%set_value(status="DISCARDED_RMAX", discard_time=param%t, discard_xh=tp%xh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_RMAX", discard_time=nbody_system%t, discard_rh=tp%rh(:,i), & discard_vh=tp%vh(:,i)) else if ((param%rmin >= 0.0_DP) .and. (rh2 < rmin2)) then tp%status(i) = DISCARDED_RMIN write(idstr, *) tp%id(i) - write(timestr, *) param%t + write(timestr, *) nbody_system%t write(*, *) "Particle " // trim(adjustl(tp%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " too close to the central body at t = " // trim(adjustl(timestr)) tp%ldiscard(i) = .true. tp%lmask(i) = .false. - call tp%info(i)%set_value(status="DISCARDED_RMIN", discard_time=param%t, discard_xh=tp%xh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_RMIN", discard_time=nbody_system%t, discard_rh=tp%rh(:,i), & discard_vh=tp%vh(:,i), discard_body_id=cb%id) else if (param%rmaxu >= 0.0_DP) then - rb2 = dot_product(tp%xb(:, i), tp%xb(:, i)) + rb2 = dot_product(tp%rb(:, i), tp%rb(:, i)) vb2 = dot_product(tp%vb(:, i), tp%vb(:, i)) energy = 0.5_DP * vb2 - Gmtot / sqrt(rb2) if ((energy > 0.0_DP) .and. (rb2 > rmaxu2)) then tp%status(i) = DISCARDED_RMAXU write(idstr, *) tp%id(i) - write(timestr, *) param%t + write(timestr, *) nbody_system%t write(*, *) "Particle " // trim(adjustl(tp%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " is unbound and too far from barycenter at t = " // trim(adjustl(timestr)) tp%ldiscard(i) = .true. tp%lmask(i) = .false. - call tp%info(i)%set_value(status="DISCARDED_RMAXU", discard_time=param%t, discard_xh=tp%xh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_RMAXU", discard_time=nbody_system%t, discard_rh=tp%rh(:,i), & discard_vh=tp%vh(:,i)) end if end if @@ -173,10 +172,10 @@ subroutine discard_cb_tp(tp, system, param) end associate return - end subroutine discard_cb_tp + end subroutine swiftest_discard_cb_tp - subroutine discard_peri_tp(tp, system, param) + subroutine swiftest_discard_peri_tp(tp, nbody_system, param) !! author: David A. Minton !! !! Check to see if a test particle should be discarded because its perihelion distance becomes too small @@ -186,7 +185,7 @@ subroutine discard_peri_tp(tp, system, param) implicit none ! Arguments class(swiftest_tp), intent(inout) :: tp !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameterss ! Internals integer(I4B) :: i, j, ih @@ -194,14 +193,14 @@ subroutine discard_peri_tp(tp, system, param) real(DP), dimension(NDIM) :: dx character(len=STRMAX) :: idstr, timestr - associate(cb => system%cb, ntp => tp%nbody, pl => system%pl, npl => system%pl%nbody, t => param%t) - call tp%get_peri(system, param) + associate(cb => nbody_system%cb, ntp => tp%nbody, pl => nbody_system%pl, npl => nbody_system%pl%nbody, t => nbody_system%t) + call tp%get_peri(nbody_system, param) do i = 1, ntp if (tp%status(i) == ACTIVE) then if (tp%isperi(i) == 0) then ih = 1 do j = 1, npl - dx(:) = tp%xh(:, i) - pl%xh(:, j) + dx(:) = tp%rh(:, i) - pl%rh(:, j) r2 = dot_product(dx(:), dx(:)) if (r2 <= (pl%rhill(j))**2) ih = 0 end do @@ -211,11 +210,11 @@ subroutine discard_peri_tp(tp, system, param) (tp%peri(i) <= param%qmin)) then tp%status(i) = DISCARDED_PERI write(idstr, *) tp%id(i) - write(timestr, *) param%t + write(timestr, *) nbody_system%t write(*, *) "Particle " // trim(adjustl(tp%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " perihelion distance too small at t = " // trim(adjustl(timestr)) tp%ldiscard(i) = .true. - call tp%info(i)%set_value(status="DISCARDED_PERI", discard_time=param%t, discard_xh=tp%xh(:,i), & + 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)) end if end if @@ -225,10 +224,10 @@ subroutine discard_peri_tp(tp, system, param) end associate return - end subroutine discard_peri_tp + end subroutine swiftest_discard_peri_tp - subroutine discard_pl_tp(tp, system, param) + subroutine swiftest_discard_pl_tp(tp, nbody_system, param) !! author: David A. Minton !! !! Check to see if test particles should be discarded based on their positions relative to the massive bodies @@ -238,7 +237,7 @@ subroutine discard_pl_tp(tp, system, param) implicit none ! Arguments class(swiftest_tp), intent(inout) :: tp !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, j, isp @@ -246,26 +245,26 @@ subroutine discard_pl_tp(tp, system, param) real(DP), dimension(NDIM) :: dx, dv character(len=STRMAX) :: idstri, idstrj, timestr - associate(ntp => tp%nbody, pl => system%pl, npl => system%pl%nbody, t => param%t, dt => param%dt) + associate(ntp => tp%nbody, pl => nbody_system%pl, npl => nbody_system%pl%nbody, t => nbody_system%t, dt => param%dt) do i = 1, ntp if (tp%status(i) == ACTIVE) then do j = 1, npl - dx(:) = tp%xh(:, i) - pl%xh(:, j) + dx(:) = tp%rh(:, i) - pl%rh(:, j) dv(:) = tp%vh(:, i) - pl%vh(:, j) radius = pl%radius(j) - call discard_pl_close(dx(:), dv(:), dt, radius**2, isp, r2min) + call swiftest_discard_pl_close(dx(:), dv(:), dt, radius**2, isp, r2min) if (isp /= 0) then tp%status(i) = DISCARDED_PLR tp%lmask(i) = .false. pl%ldiscard(j) = .true. write(idstri, *) tp%id(i) write(idstrj, *) pl%id(j) - write(timestr, *) param%t + write(timestr, *) nbody_system%t write(*, *) "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)) tp%ldiscard(i) = .true. - call tp%info(i)%set_value(status="DISCARDED_PLR", discard_time=param%t, discard_xh=tp%xh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_PLR", discard_time=nbody_system%t, discard_rh=tp%rh(:,i), & discard_vh=tp%vh(:,i), discard_body_id=pl%id(j)) exit end if @@ -275,10 +274,10 @@ subroutine discard_pl_tp(tp, system, param) end associate return - end subroutine discard_pl_tp + end subroutine swiftest_discard_pl_tp - subroutine discard_pl_close(dx, dv, dt, r2crit, iflag, r2min) + subroutine swiftest_discard_pl_close(dx, dv, dt, r2crit, iflag, r2min) !! author: David A. Minton !! !! Check to see if a test particle and massive body are having, or will have within the next time step, an encounter such @@ -320,6 +319,6 @@ subroutine discard_pl_close(dx, dv, dt, r2crit, iflag, r2min) end if return - end subroutine discard_pl_close + end subroutine swiftest_discard_pl_close -end submodule s_discard +end submodule s_swiftest_discard diff --git a/src/drift/drift.f90 b/src/swiftest/swiftest_drift.f90 similarity index 88% rename from src/drift/drift.f90 rename to src/swiftest/swiftest_drift.f90 index b2e3c1b9a..89f8afa16 100644 --- a/src/drift/drift.f90 +++ b/src/swiftest/swiftest_drift.f90 @@ -7,8 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (swiftest_classes) drift_implementation - use swiftest +submodule (swiftest) s_swiftest_drift !> Integration control parameters: real(DP), parameter :: E2MAX = 0.36_DP real(DP), parameter :: DM2MAX = 0.16_DP @@ -19,7 +18,7 @@ contains - module subroutine drift_body(self, system, param, dt) + module subroutine swiftest_drift_body(self, nbody_system, param, dt) !! author: David A. Minton !! !! Loop bodies and call Danby drift routine on the heliocentric position and velocities. @@ -29,7 +28,7 @@ module subroutine drift_body(self, system, param, dt) implicit none ! Arguments class(swiftest_body), intent(inout) :: self !! Swiftest test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + 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 ! Internals @@ -39,7 +38,7 @@ module subroutine drift_body(self, system, param, dt) associate(n => self%nbody) allocate(iflag(n)) iflag(:) = 0 - call drift_all(self%mu, self%xh, self%vh, self%nbody, param, dt, self%lmask, iflag) + call swiftest_drift_all(self%mu, self%rh, self%vh, self%nbody, param, dt, self%lmask, iflag) if (any(iflag(1:n) /= 0)) then where(iflag(1:n) /= 0) self%status(1:n) = DISCARDED_DRIFTERR do i = 1, n @@ -51,10 +50,10 @@ module subroutine drift_body(self, system, param, dt) deallocate(iflag) return - end subroutine drift_body + end subroutine swiftest_drift_body - module subroutine drift_all(mu, x, v, n, param, dt, lmask, iflag) + module subroutine swiftest_drift_all(mu, x, v, n, param, dt, lmask, iflag) !! author: David A. Minton !! !! Loop bodies and call Danby drift routine on all bodies for the given position and velocity vector. @@ -91,17 +90,17 @@ module subroutine drift_all(mu, x, v, n, param, dt, lmask, iflag) !!$omp simd ! SIMD does not yet work do i = 1, n - if (lmask(i)) call drift_one(mu(i), x(1,i), x(2,i), x(3,i), v(1,i), v(2,i), v(3,i), dtp(i), iflag(i)) + if (lmask(i)) call swiftest_drift_one(mu(i), x(1,i), x(2,i), x(3,i), v(1,i), v(2,i), v(3,i), dtp(i), iflag(i)) end do !!$omp end simd deallocate(dtp) return - end subroutine drift_all + end subroutine swiftest_drift_all - pure elemental module subroutine drift_one(mu, px, py, pz, vx, vy, vz, dt, iflag) + pure elemental module subroutine swiftest_drift_one(mu, px, py, pz, vx, vy, vz, dt, iflag) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! !! Perform Danby drift for one body, redoing drift with smaller substeps if original accuracy is insufficient @@ -118,20 +117,20 @@ pure elemental module subroutine drift_one(mu, px, py, pz, vx, vy, vz, dt, iflag integer(I4B) :: i real(DP) :: dttmp - call drift_dan(mu, px, py, pz, vx, vy, vz, dt, iflag) + call swiftest_drift_dan(mu, px, py, pz, vx, vy, vz, dt, iflag) if (iflag /= 0) then dttmp = 0.1_DP * dt do i = 1, 10 - call drift_dan(mu, px, py, pz, vx, vy, vz, dttmp, iflag) + call swiftest_drift_dan(mu, px, py, pz, vx, vy, vz, dttmp, iflag) if (iflag /= 0) exit end do end if - + return - end subroutine drift_one + end subroutine swiftest_drift_one - pure subroutine drift_dan(mu, px0, py0, pz0, vx0, vy0, vz0, dt0, iflag) + pure subroutine swiftest_drift_dan(mu, px0, py0, pz0, vx0, vy0, vz0, dt0, iflag) !! author: David A. Minton !! !! Perform Kepler drift, solving Kepler's equation in appropriate variables @@ -169,7 +168,7 @@ pure subroutine drift_dan(mu, px0, py0, pz0, vx0, vy0, vz0, dt0, iflag) dm = dt * en - int(dt * en / TWOPI, kind = I4B) * TWOPI dt = dm / en if ((esq < E2MAX) .and. (dm**2 < DM2MAX) .and. (esq * dm**2 < E2DM2MAX)) then - call drift_kepmd(dm, es, ec, xkep, s, c) + call swiftest_drift_kepmd(dm, es, ec, xkep, s, c) fchk = (xkep - ec * s + es * (1.0_DP - c) - dm) ! DEK - original code compared fchk*fchk with DANBYB, but i think it should ! DEK - be compared with DANBYB*DANBYB, and i changed it accordingly - please @@ -192,7 +191,7 @@ pure subroutine drift_dan(mu, px0, py0, pz0, vx0, vy0, vz0, dt0, iflag) end if end if - call drift_kepu(dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) + call swiftest_drift_kepu(dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) if (iflag == 0) then f = 1.0_DP - mu / r0 * c2 g = dt - mu * c3 @@ -205,10 +204,10 @@ pure subroutine drift_dan(mu, px0, py0, pz0, vx0, vy0, vz0, dt0, iflag) end if return - end subroutine drift_dan + end subroutine swiftest_drift_dan - pure subroutine drift_kepmd(dm, es, ec, x, s, c) + pure subroutine swiftest_drift_kepmd(dm, es, ec, x, s, c) !! author: David A. Minton !! !! Solve Kepler's equation in difference form for an ellipse for small input dm and eccentricity @@ -250,10 +249,10 @@ pure subroutine drift_kepmd(dm, es, ec, x, s, c) c = sqrt(1.0_DP - s**2) return - end subroutine drift_kepmd + end subroutine swiftest_drift_kepmd - pure subroutine drift_kepu(dt,r0,mu,alpha,u,fp,c1,c2,c3,iflag) + pure subroutine swiftest_drift_kepu(dt,r0,mu,alpha,u,fp,c1,c2,c3,iflag) !! author: David A. Minton !! !! Solve Kepler's equation in universal variables @@ -267,21 +266,21 @@ pure subroutine drift_kepu(dt,r0,mu,alpha,u,fp,c1,c2,c3,iflag) real(DP) :: s, st, fo, fn ! executable code - call drift_kepu_guess(dt, r0, mu, alpha, u, s) + call swiftest_drift_kepu_guess(dt, r0, mu, alpha, u, s) st = s - call drift_kepu_new(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) + call swiftest_drift_kepu_new(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) if (iflag /= 0) then - call drift_kepu_fchk(dt, r0, mu, alpha, u, st, fo) - call drift_kepu_fchk(dt, r0, mu, alpha, u, s, fn) + call swiftest_drift_kepu_fchk(dt, r0, mu, alpha, u, st, fo) + call swiftest_drift_kepu_fchk(dt, r0, mu, alpha, u, s, fn) if (abs(fo) < abs(fn)) s = st - call drift_kepu_lag(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) + call swiftest_drift_kepu_lag(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) end if return - end subroutine drift_kepu + end subroutine swiftest_drift_kepu - pure subroutine drift_kepu_fchk(dt, r0, mu, alpha, u, s, f) + pure subroutine swiftest_drift_kepu_fchk(dt, r0, mu, alpha, u, s, f) !! author: David A. Minton !! !! Computes the value of f, the function whose root we are trying to find in universal variables @@ -301,17 +300,17 @@ pure subroutine drift_kepu_fchk(dt, r0, mu, alpha, u, s, f) real(DP) :: x, c0, c1, c2, c3 x = s**2 * alpha - call drift_kepu_stumpff(x, c0, c1, c2, c3) + call swiftest_drift_kepu_stumpff(x, c0, c1, c2, c3) c1 = c1 * s c2 = c2 * s**2 c3 = c3 * s**3 f = r0 * c1 + u * c2 + mu * c3 - dt return - end subroutine drift_kepu_fchk + end subroutine swiftest_drift_kepu_fchk - pure subroutine drift_kepu_guess(dt, r0, mu, alpha, u, s) + pure subroutine swiftest_drift_kepu_guess(dt, r0, mu, alpha, u, s) !! author: David A. Minton !! !! Compute initial guess for solving Kepler's equation using universal variables @@ -341,21 +340,21 @@ pure subroutine drift_kepu_guess(dt, r0, mu, alpha, u, s) es = u / (en * a**2) e = sqrt(ec**2 + es**2) y = en * dt - es - call orbel_scget(y, sy, cy) + call swiftest_orbel_scget(y, sy, cy) sigma = sign(1.0_DP, es * cy + ec * sy) x = y + sigma * danbyk * e s = x / sqrt(alpha) end if else - call drift_kepu_p3solve(dt, r0, mu, alpha, u, s, iflag) + call swiftest_drift_kepu_p3solve(dt, r0, mu, alpha, u, s, iflag) if (iflag /= 0) s = dt / r0 end if return - end subroutine drift_kepu_guess + end subroutine swiftest_drift_kepu_guess - pure subroutine drift_kepu_lag(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) + pure subroutine swiftest_drift_kepu_lag(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) !! author: David A. Minton !! !! Solve Kepler's equation in universal variables using Laguerre's method @@ -380,7 +379,7 @@ pure subroutine drift_kepu_lag(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) integer(I4B) :: nc, ncmax real(DP) :: x, fpp, ds, c0, f, fdt integer(I4B), parameter :: ln = 5 - + if (alpha < 0.0_DP) then ncmax = NLAG2 else @@ -388,7 +387,7 @@ pure subroutine drift_kepu_lag(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) end if do nc = 0, ncmax x = s * s * alpha - call drift_kepu_stumpff(x, c0, c1, c2, c3) + call swiftest_drift_kepu_stumpff(x, c0, c1, c2, c3) c1 = c1 * s c2 = c2 * s**2 c3 = c3 * s**3 @@ -406,10 +405,10 @@ pure subroutine drift_kepu_lag(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) iflag = 2 return - end subroutine drift_kepu_lag + end subroutine swiftest_drift_kepu_lag - pure subroutine drift_kepu_new(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) + pure subroutine swiftest_drift_kepu_new(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) !! author: David A. Minton !! !! Solve Kepler's equation in universal variables using Newton's method @@ -433,10 +432,10 @@ pure subroutine drift_kepu_new(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) ! Internals integer( I4B) :: nc real(DP) :: x, c0, ds, f, fpp, fppp, fdt - + do nc = 0, 6 x = s**2 * alpha - call drift_kepu_stumpff(x, c0, c1, c2, c3) + call swiftest_drift_kepu_stumpff(x, c0, c1, c2, c3) c1 = c1 * s c2 = c2 * s**2 c3 = c3 * s**3 @@ -455,12 +454,12 @@ pure subroutine drift_kepu_new(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) end if end do iflag = 1 - + return - end subroutine drift_kepu_new + end subroutine swiftest_drift_kepu_new - pure subroutine drift_kepu_p3solve(dt, r0, mu, alpha, u, s, iflag) + pure subroutine swiftest_drift_kepu_p3solve(dt, r0, mu, alpha, u, s, iflag) !! author: David A. Minton !! !! Computes real root of cubic involved in setting initial guess for solving Kepler's equation in universal variables @@ -507,10 +506,10 @@ pure subroutine drift_kepu_p3solve(dt, r0, mu, alpha, u, s, iflag) end if return - end subroutine drift_kepu_p3solve - + end subroutine swiftest_drift_kepu_p3solve + - pure subroutine drift_kepu_stumpff(x, c0, c1, c2, c3) + pure subroutine swiftest_drift_kepu_stumpff(x, c0, c1, c2, c3) !! author: David A. Minton !! !! Compute Stumpff functions needed for Kepler drift in universal variables @@ -537,10 +536,10 @@ pure subroutine drift_kepu_stumpff(x, c0, c1, c2, c3) end do c2 = (1.0_DP - x * (1.0_DP - x * (1.0_DP - x * (1.0_DP - x * (1.0_DP - x * & (1.0_DP - x / 182.0_DP) / 132.0_DP) / 90.0_DP) / 56.0_DP) / & - 30.0_DP) / 12.0_DP) / 2.0_DP + 30.0_DP) / 12.0_DP) / 2.0_DP c3 = (1.0_DP - x * (1.0_DP - x * (1.0_DP - x * (1.0_DP - x * (1.0_DP - x * & (1.0_DP - x / 210.0_DP) / 156.0_DP) / 110.0_DP) / 72.0_DP) / & - 42.0_DP) / 20.0_DP ) / 6.0_DP + 42.0_DP) / 20.0_DP ) / 6.0_DP c1 = 1.0_DP - x * c3 c0 = 1.0_DP - x * c2 if (n /= 0) then @@ -554,7 +553,7 @@ pure subroutine drift_kepu_stumpff(x, c0, c1, c2, c3) end if return - end subroutine drift_kepu_stumpff + end subroutine swiftest_drift_kepu_stumpff -end submodule drift_implementation +end submodule s_swiftest_drift diff --git a/src/swiftest/swiftest_driver.f90 b/src/swiftest/swiftest_driver.f90 new file mode 100644 index 000000000..e2ee1c054 --- /dev/null +++ b/src/swiftest/swiftest_driver.f90 @@ -0,0 +1,170 @@ +!! 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. + +program swiftest_driver + !! author: David A. Minton + !! + !! Driver program for the Swiftest integrators. Unlike the earlier Swift and Swifter drivers, in Swiftest all integrators + !! are run from this single program. + !! + !! Adapted from Swifter by David E. Kaufmann's Swifter driver programs swifter_[bs,helio,ra15,rmvs,symba,tu4,whm].f90 + !! Adapted from Hal Levison and Martin Duncan's Swift driver programs + use swiftest + use symba + implicit none + + class(swiftest_nbody_system), allocatable :: nbody_system !! Polymorphic object containing the nbody system to be integrated + class(swiftest_parameters), allocatable :: param !! Run configuration parameters + character(len=:), allocatable :: integrator !! Integrator type code (see globals for symbolic names) + character(len=:), allocatable :: param_file_name !! Name of the file containing user-defined parameters + character(len=:), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT", "PROGRESS"}). Default is "STANDARD" + integer(I8B) :: istart !! Starting index for loop counter + integer(I8B) :: nloops !! Number of steps to take in the simulation + integer(I4B) :: iout !! Output cadence counter + integer(I4B) :: idump !! Dump cadence counter + type(walltimer) :: integration_timer !! Object used for computing elapsed wall time + real(DP) :: tfrac !! Fraction of total simulation time completed + type(progress_bar) :: pbar !! Object used to print out a progress bar + character(*), parameter :: statusfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & + '"; Number of active pl, tp = ", I6, ", ", I6)' + character(*), parameter :: symbastatfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & + '"; Number of active plm, pl, tp = ", I6, ", ", I6, ", ", I6)' + character(*), parameter :: pbarfmt = '("Time = ", ES12.5," of ",ES12.5)' + character(len=64) :: pbarmessage + + character(*), parameter :: symbacompactfmt = '(";NPLM",ES22.15,$)' + !type(base_storage(nframes=:)), allocatable :: system_history + + call swiftest_io_get_args(integrator, param_file_name, display_style) + + !> Read in the user-defined parameters file and the initial conditions of the nbody_system + allocate(swiftest_parameters :: param) + param%integrator = trim(adjustl(integrator)) + call param%set_display(display_style) + call param%read_in(param_file_name) + + + associate(t0 => param%t0, & + tstart => param%tstart, & + dt => param%dt, & + tstop => param%tstop, & + iloop => param%iloop, & + istep_out => param%istep_out, & + dump_cadence => param%dump_cadence, & + ioutput => param%ioutput, & + display_style => param%display_style, & + display_unit => param%display_unit) + + + ! Set up loop and output cadence variables + nloops = ceiling((tstop - t0) / dt, kind=I8B) + istart = ceiling((tstart - t0) / dt + 1.0_DP, kind=I8B) + ioutput = max(int(istart / istep_out, kind=I4B),1) + + ! Set up nbody_system storage for intermittent file dumps + if (dump_cadence == 0) dump_cadence = ceiling(nloops / (1.0_DP * istep_out), kind=I8B) + + ! Construct the main n-body nbody_system using the user-input integrator to choose the type of nbody_system + call swiftest_util_setup_construct_system(nbody_system, param) + + !> Define the maximum number of threads + nthreads = 1 ! In the *serial* case + !$ nthreads = omp_get_max_threads() ! In the *parallel* case + !$ write(param%display_unit,'(a)') ' OpenMP parameters:' + !$ write(param%display_unit,'(a)') ' ------------------' + !$ write(param%display_unit,'(a,i3,/)') ' Number of threads = ', nthreads + !$ if (param%log_output) write(*,'(a,i3)') ' OpenMP: Number of threads = ',nthreads + + call nbody_system%initialize(param) + + associate (system_history => param%system_history) + ! If this is a new run, compute energy initial conditions (if energy tracking is turned on) and write the initial conditions to file. + if (param%lenergy) then + if (param%lrestart) then + call nbody_system%conservation_report(param, lterminal=.true.) + else + call nbody_system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum + end if + end if + call system_history%take_snapshot(param,nbody_system) + call nbody_system%dump(param) + + write(display_unit, *) " *************** Main Loop *************** " + + if (display_style == "PROGRESS") then + call pbar%reset(nloops) + write(pbarmessage,fmt=pbarfmt) t0, tstop + call pbar%update(1,message=pbarmessage) + else if (display_style == "COMPACT") then + write(*,*) "SWIFTEST START " // param%integrator + call nbody_system%compact_output(param,integration_timer) + end if + + iout = 0 + idump = 0 + nbody_system%t = tstart + do iloop = istart, nloops + !> Step the nbody_system forward in time + call integration_timer%start() + call nbody_system%step(param, nbody_system%t, dt) + call integration_timer%stop() + + nbody_system%t = t0 + iloop * dt + + !> Evaluate any discards or collisional outcomes + call nbody_system%discard(param) + if (display_style == "PROGRESS") call pbar%update(iloop) + + !> If the loop counter is at the output cadence value, append the data file with a single frame + if (istep_out > 0) then + iout = iout + 1 + if (iout == istep_out) then + iout = 0 + idump = idump + 1 + call system_history%take_snapshot(param,nbody_system) + + if (idump == dump_cadence) then + idump = 0 + call nbody_system%dump(param) + + end if + + tfrac = (nbody_system%t - t0) / (tstop - t0) + + select type(pl => nbody_system%pl) + class is (symba_pl) + write(display_unit, symbastatfmt) nbody_system%t, tfrac, pl%nplm, pl%nbody, nbody_system%tp%nbody + class default + write(display_unit, statusfmt) nbody_system%t, tfrac, pl%nbody, nbody_system%tp%nbody + end select + if (param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) + call integration_timer%report(message="Integration steps:", unit=display_unit, nsubsteps=istep_out) + + if (display_style == "PROGRESS") then + write(pbarmessage,fmt=pbarfmt) nbody_system%t, tstop + call pbar%update(1,message=pbarmessage) + else if (display_style == "COMPACT") then + call nbody_system%compact_output(param,integration_timer) + end if + + call integration_timer%reset() + + end if + end if + + end do + ! Dump any remaining history if it exists + call nbody_system%dump(param) + call system_history%dump(param) + if (display_style == "COMPACT") write(*,*) "SWIFTEST STOP" // param%integrator + end associate + end associate + + call util_exit(SUCCESS) +end program swiftest_driver diff --git a/src/gr/gr.f90 b/src/swiftest/swiftest_gr.f90 similarity index 86% rename from src/gr/gr.f90 rename to src/swiftest/swiftest_gr.f90 index 8b32c7654..3274f218e 100644 --- a/src/gr/gr.f90 +++ b/src/swiftest/swiftest_gr.f90 @@ -7,11 +7,10 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(swiftest_classes) s_gr - use swiftest +submodule(swiftest) s_swiftest_gr contains - pure module subroutine gr_kick_getaccb_ns_body(self, system, param) + pure module subroutine swiftest_gr_kick_getaccb_ns_body(self, nbody_system, param) !! author: David A. Minton !! !! Add relativistic correction acceleration for non-symplectic integrators. @@ -25,20 +24,20 @@ pure module subroutine gr_kick_getaccb_ns_body(self, system, param) implicit none ! Arguments class(swiftest_body), intent(inout) :: self !! Swiftest generic body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals real(DP) :: rmag, rdotv, vmag2 integer(I4B) :: i - associate(n => self%nbody, cb => system%cb, inv_c2 => param%inv_c2) + associate(n => self%nbody, cb => nbody_system%cb, inv_c2 => param%inv_c2) if (n == 0) return do i = 1, n - rmag = norm2(self%xh(:,i)) + rmag = norm2(self%rh(:,i)) vmag2 = dot_product(self%vh(:,i), self%vh(:,i)) - rdotv = dot_product(self%xh(:,i), self%vh(:,i)) + rdotv = dot_product(self%rh(:,i), self%vh(:,i)) self%agr(:, i) = self%mu * inv_c2 / rmag**3 * ((4 * self%mu(i) / rmag - vmag2) & - * self%xh(:,i) + 4 * rdotv * self%vh(:,i)) + * self%rh(:,i) + 4 * rdotv * self%vh(:,i)) end do select type(self) @@ -51,10 +50,10 @@ pure module subroutine gr_kick_getaccb_ns_body(self, system, param) end associate return - end subroutine gr_kick_getaccb_ns_body + end subroutine swiftest_gr_kick_getaccb_ns_body - pure module subroutine gr_kick_getacch(mu, x, lmask, n, inv_c2, agr) + pure module subroutine swiftest_gr_kick_getacch(mu, x, lmask, n, inv_c2, agr) !! author: David A. Minton !! !! Compute relativisitic accelerations of massive bodies @@ -81,10 +80,10 @@ pure module subroutine gr_kick_getacch(mu, x, lmask, n, inv_c2, agr) end do return - end subroutine gr_kick_getacch + end subroutine swiftest_gr_kick_getacch - pure module subroutine gr_p4_pos_kick(param, x, v, dt) + pure module subroutine swiftest_gr_p4_pos_kick(param, x, v, dt) !! author: David A. Minton !! !! Position kick due to p**4 term in the post-Newtonian correction @@ -110,10 +109,10 @@ pure module subroutine gr_p4_pos_kick(param, x, v, dt) x(:) = x(:) + dr(:) * dt return - end subroutine gr_p4_pos_kick + end subroutine swiftest_gr_p4_pos_kick - pure module subroutine gr_pseudovel2vel(param, mu, xh, pv, vh) + pure module subroutine swiftest_gr_pseudovel2vel(param, mu, rh, pv, vh) !! author: David A. Minton !! !! Converts the relativistic pseudovelocity back into a veliocentric velocity @@ -128,7 +127,7 @@ pure module subroutine gr_pseudovel2vel(param, mu, xh, pv, vh) ! Arguments 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) :: xh !! Heliocentric position vector + real(DP), dimension(:), intent(in) :: rh !! Heliocentric position vector real(DP), dimension(:), intent(in) :: pv !! Pseudovelocity velocity vector - see Saha & Tremain (1994), eq. (32) real(DP), dimension(:), intent(out) :: vh !! Heliocentric velocity vector ! Internals @@ -136,16 +135,16 @@ pure module subroutine gr_pseudovel2vel(param, mu, xh, pv, vh) associate(inv_c2 => param%inv_c2) vmag2 = dot_product(pv(:), pv(:)) - rmag = norm2(xh(:)) + rmag = norm2(rh(:)) grterm = 1.0_DP - inv_c2 * (0.5_DP * vmag2 + 3 * mu / rmag) vh(:) = pv(:) * grterm end associate return - end subroutine gr_pseudovel2vel + end subroutine swiftest_gr_pseudovel2vel - pure module subroutine gr_pv2vh_body(self, param) + pure module subroutine swiftest_gr_pv2vh_body(self, param) !! author: David A. Minton !! !! Wrapper function that converts from pseudovelocity to heliocentric velocity for swiftest bodies @@ -161,16 +160,16 @@ pure module subroutine gr_pv2vh_body(self, param) if (n == 0) return allocate(vh, mold = self%vh) do i = 1, n - call gr_pseudovel2vel(param, self%mu(i), self%xh(:, i), self%vh(:, i), vh(:, i)) + call swiftest_gr_pseudovel2vel(param, self%mu(i), self%rh(:, i), self%vh(:, i), vh(:, i)) end do call move_alloc(vh, self%vh) end associate return - end subroutine gr_pv2vh_body + end subroutine swiftest_gr_pv2vh_body - pure module subroutine gr_vel2pseudovel(param, mu, xh, vh, pv) + pure module subroutine swiftest_gr_vel2pseudovel(param, mu, rh, vh, pv) !! author: David A. Minton !! !! Converts the heliocentric velocity into a pseudovelocity with relativistic corrections. @@ -186,7 +185,7 @@ pure module subroutine gr_vel2pseudovel(param, mu, xh, vh, pv) ! Arguments 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) :: xh !! Heliocentric position vector + real(DP), dimension(:), intent(in) :: rh !! Heliocentric position vector real(DP), dimension(:), intent(in) :: vh !! Heliocentric velocity vector real(DP), dimension(:), intent(out) :: pv !! Pseudovelocity vector - see Saha & Tremain (1994), eq. (32) ! Internals @@ -199,7 +198,7 @@ pure module subroutine gr_vel2pseudovel(param, mu, xh, vh, pv) associate(inv_c2 => param%inv_c2) pv(1:NDIM) = vh(1:NDIM) ! Initial guess - rterm = 3 * mu / norm2(xh(:)) + rterm = 3 * mu / norm2(rh(:)) v2 = dot_product(vh(:), vh(:)) do n = 1, MAXITER pv2 = dot_product(pv(:), pv(:)) @@ -244,10 +243,10 @@ pure module subroutine gr_vel2pseudovel(param, mu, xh, vh, pv) end associate return - end subroutine gr_vel2pseudovel + end subroutine swiftest_gr_vel2pseudovel - pure module subroutine gr_vh2pv_body(self, param) + pure module subroutine swiftest_gr_vh2pv_body(self, param) !! author: David A. Minton !! !! Wrapper function that converts from heliocentric velocity to pseudovelocity for Swiftest bodies @@ -263,12 +262,12 @@ pure module subroutine gr_vh2pv_body(self, param) if (n == 0) return allocate(pv, mold = self%vh) do i = 1, n - call gr_vel2pseudovel(param, self%mu(i), self%xh(:, i), self%vh(:, i), pv(:, i)) + call swiftest_gr_vel2pseudovel(param, self%mu(i), self%rh(:, i), self%vh(:, i), pv(:, i)) end do call move_alloc(pv, self%vh) end associate return - end subroutine gr_vh2pv_body + end subroutine swiftest_gr_vh2pv_body -end submodule s_gr \ No newline at end of file +end submodule s_swiftest_gr \ No newline at end of file diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 new file mode 100644 index 000000000..8ae50ba2d --- /dev/null +++ b/src/swiftest/swiftest_io.f90 @@ -0,0 +1,2923 @@ +!! 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. + +submodule (swiftest) s_swiftest_io + use symba + use netcdf +contains + + module subroutine swiftest_io_compact_output(self, param, timer) + !! author: David Minton + !! + !! Generates the terminal output displayed when display_style is set to COMPACT. This is used by the Python driver to + !! make nice-looking progress reports. + implicit none + + interface fmt + !! author: David Minton + !! + !! Formats a pair of variables and corresponding values for the compact display output. Generic interface for different variable types to format. + procedure :: fmt_I4B, fmt_I8B, fmt_DP + end interface + + ! Arguments + 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 (must be unlimited polymorphic because the walltimer module requires base) + ! Internals + character(len=:), allocatable :: formatted_output + + select type(timer) + class is (walltimer) + formatted_output = fmt("ILOOP",param%iloop) // fmt("T",self%t) // fmt("NPL",self%pl%nbody) // fmt("NTP",self%tp%nbody) + select type(pl => self%pl) + class is (symba_pl) + formatted_output = formatted_output // fmt("NPLM",pl%nplm) + end select + if (param%lenergy) then + formatted_output = formatted_output // fmt("LTOTERR",self%Ltot_error) // fmt("ETOTERR",self%Etot_error) // fmt("MTOTERR",self%Mtot_error) & + // fmt("KEOERR",self%ke_orbit_error) // fmt("PEERR",self%pe_error) // fmt("EORBERR",self%Eorbit_error) & + // fmt("EUNTRERR",self%Euntracked_error) // fmt("LESCERR",self%Lescape_error) // fmt("MESCERR",self%Mescape_error) + if (param%lclose) formatted_output = formatted_output // fmt("ECOLLERR",self%Ecoll_error) + if (param%lrotation) formatted_output = formatted_output // fmt("KESPINERR",self%ke_spin_error) // fmt("LSPINERR",self%Lspin_error) + end if + + if (.not. timer%main_is_started) then ! This is the start of a new run + formatted_output = formatted_output // fmt("WT",0.0_DP) // fmt("IWT",0.0_DP) // fmt("WTPS",0.0_DP) + else + formatted_output = formatted_output // fmt("WT",timer%wall_main) // fmt("IWT",timer%wall_step) // fmt("WTPS",timer%wall_per_substep) + end if + write(*,*) formatted_output + end select + return + + contains + + function fmt_I4B(varname,val) result(pair_string) + implicit none + ! Arguments + character(*), intent(in) :: varname !! The variable name of the pair + integer(I4B), intent(in) :: val !! A 4-byte integer value + ! Result + character(len=:), allocatable :: pair_string + ! Internals + character(len=24) :: str_value + + write(str_value,*) val + pair_string = trim(adjustl(varname)) // " " // trim(adjustl(str_value)) // ";" + + return + end function fmt_I4B + + function fmt_I8B(varname, val) result(pair_string) + implicit none + ! Arguments + character(*), intent(in) :: varname !! The variable name of the pair + integer(I8B), intent(in) :: val !! An 8-byte integer value + ! Result + character(len=:), allocatable :: pair_string + ! Internals + character(len=24) :: str_value + + write(str_value,*) val + pair_string = trim(adjustl(varname)) // " " // trim(adjustl(str_value)) // ";" + + return + end function fmt_I8B + + function fmt_DP(varname, val) result(pair_string) + implicit none + ! Arguments + character(*), intent(in) :: varname !! The variable name of the pair + real(DP), intent(in) :: val !! A double precision floating point value + ! Result + character(len=:), allocatable :: pair_string + ! Internals + character(len=24) :: str_value + + write(str_value,'(ES24.16)') val + pair_string = trim(adjustl(varname)) // " " // trim(adjustl(str_value)) // ";" + + return + end function fmt_DP + + end subroutine swiftest_io_compact_output + + + module subroutine swiftest_io_conservation_report(self, param, lterminal) + !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Reports the current state of energy, mass, and angular momentum conservation in a run + implicit none + ! Arguments + 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 + ! Internals + real(DP), dimension(NDIM) :: Ltot_now, Lorbit_now, Lspin_now + real(DP) :: ke_orbit_now, ke_spin_now, pe_now, Eorbit_now, be_now + real(DP) :: GMtot_now + character(len=STRMAX) :: errmsg + integer(I4B), parameter :: EGYIU = 72 + character(len=*), parameter :: EGYTERMFMT = '(" DL/L0 = ", ES12.5 & + "; DEcollisions/|E0| = ", ES12.5, & + "; D(Eorbit+Ecollisions)/|E0| = ", ES12.5, & + "; DM/M0 = ", ES12.5)' + + associate(nbody_system => self, pl => self%pl, cb => self%cb, npl => self%pl%nbody, display_unit => param%display_unit, nc => param%system_history%nc) + + call pl%vb2vh(cb) + call pl%rh2rb(cb) + + call nbody_system%get_energy_and_momentum(param) + ke_orbit_now = nbody_system%ke_orbit + ke_spin_now = nbody_system%ke_spin + pe_now = nbody_system%pe + be_now = nbody_system%be + Lorbit_now(:) = nbody_system%Lorbit(:) + Lspin_now(:) = nbody_system%Lspin(:) + Eorbit_now = ke_orbit_now + ke_spin_now + pe_now + be_now + Ltot_now(:) = nbody_system%Ltot(:) + nbody_system%Lescape(:) + GMtot_now = nbody_system%GMtot + nbody_system%GMescape + + if (param%lfirstenergy) then + nbody_system%ke_orbit_orig = ke_orbit_now + nbody_system%ke_spin_orig = ke_spin_now + nbody_system%pe_orig = pe_now + nbody_system%be_orig = be_now + nbody_system%Eorbit_orig = Eorbit_now + nbody_system%GMtot_orig = GMtot_now + nbody_system%Lorbit_orig(:) = Lorbit_now(:) + nbody_system%Lspin_orig(:) = Lspin_now(:) + nbody_system%Ltot_orig(:) = Ltot_now(:) + param%lfirstenergy = .false. + end if + + if (.not.param%lfirstenergy) then + nbody_system%ke_orbit_error = (ke_orbit_now - nbody_system%ke_orbit_orig) / abs(nbody_system%Eorbit_orig) + nbody_system%ke_spin_error = (ke_spin_now - nbody_system%ke_spin_orig) / abs(nbody_system%Eorbit_orig) + nbody_system%pe_error = (pe_now - nbody_system%pe_orig) / abs(nbody_system%Eorbit_orig) + nbody_system%be_error = (be_now - nbody_system%be_orig) / abs(nbody_system%Eorbit_orig) + nbody_system%Eorbit_error = (Eorbit_now - nbody_system%Eorbit_orig) / abs(nbody_system%Eorbit_orig) + nbody_system%Ecoll_error = nbody_system%Ecollisions / abs(nbody_system%Eorbit_orig) + nbody_system%Euntracked_error = nbody_system%Euntracked / abs(nbody_system%Eorbit_orig) + nbody_system%Etot_error = (Eorbit_now - nbody_system%Ecollisions - nbody_system%Eorbit_orig - nbody_system%Euntracked) / abs(nbody_system%Eorbit_orig) + + nbody_system%Lorbit_error = norm2(Lorbit_now(:) - nbody_system%Lorbit_orig(:)) / norm2(nbody_system%Ltot_orig(:)) + nbody_system%Lspin_error = norm2(Lspin_now(:) - nbody_system%Lspin_orig(:)) / norm2(nbody_system%Ltot_orig(:)) + nbody_system%Lescape_error = norm2(nbody_system%Lescape(:)) / norm2(nbody_system%Ltot_orig(:)) + nbody_system%Ltot_error = norm2(Ltot_now(:) - nbody_system%Ltot_orig(:)) / norm2(nbody_system%Ltot_orig(:)) + nbody_system%Mescape_error = nbody_system%GMescape / nbody_system%GMtot_orig + nbody_system%Mtot_error = (GMtot_now - nbody_system%GMtot_orig) / nbody_system%GMtot_orig + if (lterminal) write(display_unit, EGYTERMFMT) nbody_system%Ltot_error, nbody_system%Ecoll_error, nbody_system%Etot_error,nbody_system%Mtot_error + if (abs(nbody_system%Mtot_error) > 100 * epsilon(nbody_system%Mtot_error)) then + write(*,*) "Severe error! Mass not conserved! Halting!" + ! Save the frame of data to the bin file in the slot just after the present one for diagnostics + param%ioutput = param%ioutput + 1 + call self%write_frame(nc, param) + call nc%close() + call util_exit(FAILURE) + end if + end if + end associate + + return + + 667 continue + write(*,*) "Error writing energy and momentum tracking file: " // trim(adjustl(errmsg)) + call util_exit(FAILURE) + end subroutine swiftest_io_conservation_report + + + module subroutine swiftest_io_dump_param(self, param_file_name) + !! author: David A. Minton + !! + !! Dump integration parameters to file + !! + !! Adapted from David E. Kaufmann's Swifter routine io_dump_param.f90 + !! Adapted from Martin Duncan's Swift routine io_dump_param.f + implicit none + ! Arguments + 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) + ! Internals + character(STRMAX) :: errmsg !! Error message in UDIO procedure + integer(I4B) :: ierr + + open(unit = LUN, file = param_file_name, status='replace', form = 'FORMATTED', err = 667, iomsg = errmsg) + !! todo: Currently this procedure does not work in user-defined derived-type input mode + !! due to compiler incompatabilities + !write(LUN,'(DT)') param + call self%writer(LUN, iotype = "none", v_list = [0], iostat = ierr, iomsg = errmsg) + if (ierr == 0) then + close(LUN, err = 667, iomsg = errmsg) + return + end if + + 667 continue + write(*,*) "Error opening parameter dump file " // trim(adjustl(errmsg)) + call util_exit(FAILURE) + end subroutine swiftest_io_dump_param + + + module subroutine swiftest_io_dump_system(self, param) + !! author: David A. Minton + !! + !! Dumps the state of the nbody_system to files in case the simulation is interrupted. + !! As a safety mechanism, there are two dump files that are written in alternating order + !! so that if a dump file gets corrupted during writing, the user can restart from the older one. + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + class(swiftest_parameters), allocatable :: dump_param !! Local parameters variable used to parameters change input file names + !! to dump file-specific values without changing the user-defined values + integer(I4B), save :: idx = 1 !! Index of current dump file. Output flips between 2 files for extra security + !! in case the program halts during writing + character(len=:), allocatable :: param_file_name + + allocate(dump_param, source=param) + param_file_name = trim(adjustl(DUMP_PARAM_FILE(idx))) + dump_param%in_form = "XV" + dump_param%out_stat = 'APPEND' + dump_param%in_type = "NETCDF_DOUBLE" + dump_param%in_netcdf = trim(adjustl(DUMP_NC_FILE(idx))) + associate(nc => dump_param%system_history%nc) + nc%name_chunk = self%pl%nbody + self%tp%nbody + nc%time_chunk = 1 + dump_param%tstart = self%t + + call dump_param%dump(param_file_name) + + dump_param%out_form = "XV" + nc%file_name = trim(adjustl(DUMP_NC_FILE(idx))) + dump_param%ioutput = 1 + call nc%initialize(dump_param) + call self%write_frame(nc, dump_param) + call nc%close() + end associate + + idx = idx + 1 + if (idx > NDUMPFILES) idx = 1 + + ! Dump the encounter history if necessary + if (param%lenc_save_trajectory .or. param%lenc_save_closest .and. allocated(self%encounter_history)) call self%encounter_history%dump(param) + if (allocated(self%collision_history)) call self%collision_history%dump(param) + + ! Dump the nbody_system history to file + call param%system_history%dump(param) + + return + end subroutine swiftest_io_dump_system + + + module subroutine swiftest_io_dump_storage(self, param) + !! author: David A. Minton + !! + !! Dumps the time history of the simulation to file. Each time it writes a frame to file, it deallocates the nbody_system + !! object from inside. It will only dump frames with systems that are allocated, so this can be called at the end of + !! a simulation for cases when the number of saved frames is not equal to the dump cadence (for instance, if the dump + !! cadence is not divisible by the total number of loops). + implicit none + ! Arguments + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest simulation history storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i + integer(I8B) :: iloop_start + + if (self%iframe == 0) return + iloop_start = max(param%iloop - int(param%istep_out * param%dump_cadence, kind=I8B) + 1_I8B,0_I8B) + call self%make_index_map() + do i = 1, self%iframe + if (allocated(self%frame(i)%item)) then + param%ioutput = iloop_start + self%tmap(i) + select type(nbody_system => self%frame(i)%item) + class is (swiftest_nbody_system) + call nbody_system%write_frame(param) + end select + deallocate(self%frame(i)%item) + end if + end do + call self%reset() + return + end subroutine swiftest_io_dump_storage + + + module subroutine swiftest_io_get_args(integrator, param_file_name, display_style) + !! author: David A. Minton + !! + !! Reads in the name of the parameter file from command line arguments. + implicit none + ! Arguments + character(len=:), intent(inout), allocatable :: integrator !! Symbolic code of the requested integrator + character(len=:), intent(inout), allocatable :: param_file_name !! Name of the input parameters file + character(len=:), intent(inout), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT", "PROGRESS"}). Default is "STANDARD" + ! Internals + character(len=STRMAX), dimension(:), allocatable :: arg + integer(I4B), dimension(:), allocatable :: ierr + integer :: i,narg + character(len=*),parameter :: linefmt = '(A)' + + narg = command_argument_count() + if (narg > 0) then + allocate(arg(narg),ierr(narg)) + do i = 1,narg + call get_command_argument(i, arg(i), status = ierr(i)) + end do + if (any(ierr /= 0)) call util_exit(USAGE) + else + call util_exit(USAGE) + end if + + if (narg == 1) then + if (arg(1) == '-v' .or. arg(1) == '--version') then + call swiftest_util_version() + else if (arg(1) == '-h' .or. arg(1) == '--help') then + call util_exit(HELP) + else + call util_exit(USAGE) + end if + else if (narg >= 2) then + call swiftest_io_toupper(arg(1)) + select case(arg(1)) + case('BS') + integrator = INT_BS + case('HELIO') + integrator = INT_HELIO + case('RA15') + integrator = INT_RA15 + case('TU4') + integrator = INT_TU4 + case('WHM') + integrator = INT_WHM + case('RMVS') + integrator = INT_RMVS + case('SYMBA') + integrator = INT_SYMBA + case('RINGMOONS') + integrator = INT_RINGMOONS + case default + integrator = UNKNOWN_INTEGRATOR + write(*,*) trim(adjustl(arg(1))) // ' is not a valid integrator.' + call util_exit(USAGE) + end select + param_file_name = trim(adjustl(arg(2))) + end if + + if (narg == 2) then + display_style = "STANDARD" + else if (narg == 3) then + call swiftest_io_toupper(arg(3)) + display_style = trim(adjustl(arg(3))) + else + call util_exit(USAGE) + end if + + return + end subroutine swiftest_io_get_args + + + module function swiftest_io_get_token(buffer, ifirst, ilast, ierr) result(token) + !! author: David A. Minton + !! + !! Retrieves a character token from an input string. Here a token is defined as any set of contiguous non-blank characters not + !! beginning with or containing "!". If "!" is present, any remaining part of the buffer including the "!" is ignored + !! + !! Adapted from David E. Kaufmann's Swifter routine swiftest_io_get_token.f90 + implicit none + ! Arguments + 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 + ! Result + character(len=:), allocatable :: token !! Returned token string + ! Internals + integer(I4B) :: i,ilength + + ilength = len(buffer) + + if (ifirst > ilength) then + ilast = ifirst + ierr = -1 !! Bad input + token = '' + return + end if + do i = ifirst, ilength + if (buffer(i:i) /= ' ') exit + end do + if ((i > ilength) .or. (buffer(i:i) == '!')) then + ifirst = i + ilast = i + ierr = -2 !! No valid token + token = '' + return + end if + ifirst = i + do i = ifirst, ilength + if ((buffer(i:i) == ' ') .or. (buffer(i:i) == '!')) exit + end do + ilast = i - 1 + ierr = 0 + + token = buffer(ifirst:ilast) + + return + end function swiftest_io_get_token + + + module subroutine swiftest_io_log_one_message(file, message) + !! author: David A. Minton + !! + !! Writes a single message to a log file + implicit none + ! Arguments + character(len=*), intent(in) :: file !! Name of file to log + character(len=*), intent(in) :: message + ! Internals + character(STRMAX) :: errmsg + + open(unit=LUN, file=trim(adjustl(file)), status = 'OLD', position = 'APPEND', form = 'FORMATTED', err = 667, iomsg = errmsg) + write(LUN, *) trim(adjustl(message)) + close(LUN) + + return + 667 continue + write(*,*) "Error writing message to log file: " // trim(adjustl(errmsg)) + end subroutine swiftest_io_log_one_message + + + module subroutine swiftest_io_log_start(param, file, header) + !! author: David A. Minton + !! + !! Checks to see if a log file needs to be created if this is a new run, or appended if this is a restarted run + implicit none + ! Arguments + 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 + ! Internals + character(STRMAX) :: errmsg + logical :: fileExists + + inquire(file=trim(adjustl(file)), exist=fileExists) + if (.not.param%lrestart .or. .not.fileExists) then + open(unit=LUN, file=file, status="REPLACE", err = 667, iomsg = errmsg) + write(LUN, *, err = 667, iomsg = errmsg) trim(adjustl(header)) + end if + close(LUN) + + return + + 667 continue + write(*,*) "Error writing log file: " // trim(adjustl(errmsg)) + end subroutine swiftest_io_log_start + + + module subroutine swiftest_io_netcdf_flush(self, param) + !! author: David A. Minton + !! + !! Flushes the current buffer to disk by closing and re-opening the file. + !! + implicit none + ! Arguments + 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 + + call self%close() + call self%open(param) + + return + end subroutine swiftest_io_netcdf_flush + + + module function swiftest_io_netcdf_get_old_t_final_system(self, param) result(old_t_final) + !! author: David A. Minton + !! + !! Validates the dump file to check whether the dump file initial conditions duplicate the last frame of the netcdf output. + !! + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: self + class(swiftest_parameters), intent(inout) :: param + ! Result + real(DP) :: old_t_final + ! Internals + integer(I4B) :: itmax, idmax + real(DP), dimension(:), allocatable :: vals + real(DP), dimension(1) :: rtemp + real(DP), dimension(NDIM) :: rot0, Ip0, Lnow + real(DP) :: KE_orb_orig, KE_spin_orig, PE_orig, BE_orig + + associate (nc => param%system_history%nc, cb => self%cb) + call nc%open(param) + call netcdf_io_check( nf90_inquire_dimension(nc%id, nc%time_dimid, len=itmax), "netcdf_io_get_old_t_final_system time_dimid" ) + call netcdf_io_check( nf90_inquire_dimension(nc%id, nc%name_dimid, len=idmax), "netcdf_io_get_old_t_final_system name_dimid" ) + allocate(vals(idmax)) + call netcdf_io_check( nf90_get_var(nc%id, nc%time_varid, rtemp, start=[1], count=[1]), "netcdf_io_get_old_t_final_system time_varid" ) + + !old_t_final = rtemp(1) + old_t_final = param%t0 ! For NetCDF it is safe to overwrite the final t value on a restart + + if (param%lenergy) then + call netcdf_io_check( nf90_get_var(nc%id, nc%KE_orb_varid, rtemp, start=[1], count=[1]), "netcdf_io_get_old_t_final_system KE_orb_varid" ) + KE_orb_orig = rtemp(1) + + call netcdf_io_check( nf90_get_var(nc%id, nc%KE_spin_varid, rtemp, start=[1], count=[1]), "netcdf_io_get_old_t_final_system KE_spin_varid" ) + KE_spin_orig = rtemp(1) + + call netcdf_io_check( nf90_get_var(nc%id, nc%PE_varid, rtemp, start=[1], count=[1]), "netcdf_io_get_old_t_final_system PE_varid" ) + PE_orig = rtemp(1) + + call netcdf_io_check( nf90_get_var(nc%id, nc%BE_varid, rtemp, start=[1], count=[1]), "netcdf_io_get_old_t_final_system BE_varid" ) + BE_orig = rtemp(1) + + call netcdf_io_check( nf90_get_var(nc%id, nc%Ecollisions_varid, self%Ecollisions, start=[1]), "netcdf_io_get_old_t_final_system Ecollisions_varid" ) + call netcdf_io_check( nf90_get_var(nc%id, nc%Euntracked_varid, self%Euntracked, start=[1]), "netcdf_io_get_old_t_final_system Euntracked_varid" ) + + self%Eorbit_orig = KE_orb_orig + KE_spin_orig + PE_orig + BE_orig + self%Ecollisions + self%Euntracked + + call netcdf_io_check( nf90_get_var(nc%id, nc%L_orb_varid, self%Lorbit_orig(:), start=[1,1], count=[NDIM,1]), "netcdf_io_get_old_t_final_system L_orb_varid" ) + call netcdf_io_check( nf90_get_var(nc%id, nc%Lspin_varid, self%Lspin_orig(:), start=[1,1], count=[NDIM,1]), "netcdf_io_get_old_t_final_system Lspin_varid" ) + call netcdf_io_check( nf90_get_var(nc%id, nc%L_escape_varid, self%Lescape(:), start=[1,1], count=[NDIM,1]), "netcdf_io_get_old_t_final_system L_escape_varid" ) + + self%Ltot_orig(:) = self%Lorbit_orig(:) + self%Lspin_orig(:) + self%Lescape(:) + + call netcdf_io_check( nf90_get_var(nc%id, nc%Gmass_varid, vals, start=[1,1], count=[idmax,1]), "netcdf_io_get_old_t_final_system Gmass_varid" ) + call netcdf_io_check( nf90_get_var(nc%id, nc%GMescape_varid, self%GMescape, start=[1]), "netcdf_io_get_old_t_final_system GMescape_varid" ) + self%GMtot_orig = vals(1) + sum(vals(2:idmax), vals(2:idmax) == vals(2:idmax)) + self%GMescape + + cb%GM0 = vals(1) + cb%dGM = cb%Gmass - cb%GM0 + + call netcdf_io_check( nf90_get_var(nc%id, nc%radius_varid, rtemp, start=[1,1], count=[1,1]), "netcdf_io_get_old_t_final_system radius_varid" ) + cb%R0 = rtemp(1) + + if (param%lrotation) then + + call netcdf_io_check( nf90_get_var(nc%id, nc%rot_varid, rot0, start=[1,1,1], count=[NDIM,1,1]), "netcdf_io_get_old_t_final_system rot_varid" ) + call netcdf_io_check( nf90_get_var(nc%id, nc%Ip_varid, Ip0, start=[1,1,1], count=[NDIM,1,1]), "netcdf_io_get_old_t_final_system Ip_varid" ) + + cb%L0(:) = Ip0(3) * cb%GM0 * cb%R0**2 * rot0(:) + + Lnow(:) = cb%Ip(3) * cb%Gmass * cb%radius**2 * cb%rot(:) + cb%dL(:) = Lnow(:) - cb%L0(:) + end if + + end if + + deallocate(vals) + end associate + + return + end function swiftest_io_netcdf_get_old_t_final_system + + + module subroutine swiftest_io_netcdf_initialize_output(self, param) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Initialize a NetCDF file nbody_system and defines all variables. + use, intrinsic :: ieee_arithmetic + implicit none + ! Arguments + 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 + ! Internals + integer(I4B) :: nvar, varid, vartype + real(DP) :: dfill + real(SP) :: sfill + integer(I4B), parameter :: NO_FILL = 0 + logical :: fileExists + character(len=STRMAX) :: errmsg + integer(I4B) :: ndims + + associate(nc => self) + + dfill = ieee_value(dfill, IEEE_QUIET_NAN) + sfill = ieee_value(sfill, IEEE_QUIET_NAN) + + select case (param%out_type) + case("NETCDF_FLOAT") + nc%out_type = NF90_FLOAT + case("NETCDF_DOUBLE") + nc%out_type = NF90_DOUBLE + case default + write(*,*) trim(adjustl(param%out_type)), " is an invalid OUT_TYPE" + end select + + ! Check if the file exists, and if it does, delete it + inquire(file=nc%file_name, exist=fileExists) + if (fileExists) then + open(unit=LUN, file=nc%file_name, status="old", err=667, iomsg=errmsg) + close(unit=LUN, status="delete") + end if + + ! Create the file + call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "netcdf_io_initialize_output nf90_create" ) + nc%lfile_is_open = .true. + + ! Dimensions + call netcdf_io_check( nf90_def_dim(nc%id, nc%time_dimname, NF90_UNLIMITED, nc%time_dimid), "netcdf_io_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension + call netcdf_io_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "netcdf_io_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), "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 (aka character arrays) + + ! Dimension coordinates + call netcdf_io_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "netcdf_io_initialize_output nf90_def_var time_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "netcdf_io_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), "netcdf_io_initialize_output nf90_def_var name_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" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%npl_varname, NF90_INT, nc%time_dimid, nc%npl_varid), "netcdf_io_initialize_output nf90_def_var npl_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%ntp_varname, NF90_INT, nc%time_dimid, nc%ntp_varid), "netcdf_io_initialize_output nf90_def_var ntp_varid" ) + if (param%lmtiny_pl) call netcdf_io_check( nf90_def_var(nc%id, nc%nplm_varname, NF90_INT, nc%time_dimid, nc%nplm_varid), "netcdf_io_initialize_output nf90_def_var nplm_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "netcdf_io_initialize_output nf90_def_var ptype_varid" ) + + if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then + call netcdf_io_check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rh_varid), "netcdf_io_initialize_output nf90_def_var rh_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], 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 during the conversion. + if (param%lgr) then + call netcdf_io_check( nf90_def_var(nc%id, nc%gr_pseudo_vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%gr_pseudo_vh_varid), "netcdf_io_initialize_output nf90_def_var gr_psuedo_vh_varid" ) + nc%lpseudo_vel_exists = .true. + end if + + end if + + if ((param%out_form == "EL") .or. (param%out_form == "XVEL")) then + call netcdf_io_check( nf90_def_var(nc%id, nc%a_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%a_varid), "netcdf_io_initialize_output nf90_def_var a_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%e_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%e_varid), "netcdf_io_initialize_output nf90_def_var e_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%inc_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%inc_varid), "netcdf_io_initialize_output nf90_def_var inc_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%capom_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%capom_varid), "netcdf_io_initialize_output nf90_def_var capom_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%omega_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%omega_varid), "netcdf_io_initialize_output nf90_def_var omega_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%capm_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%capm_varid), "netcdf_io_initialize_output nf90_def_var capm_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%varpi_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%varpi_varid), "netcdf_io_initialize_output nf90_def_var varpi_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%lam_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%lam_varid), "netcdf_io_initialize_output nf90_def_var lam_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%f_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%f_varid), "netcdf_io_initialize_output nf90_def_var f_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%cape_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%cape_varid), "netcdf_io_initialize_output nf90_def_var cape_varid" ) + end if + + call netcdf_io_check( nf90_def_var(nc%id, nc%gmass_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Gmass_varid), "netcdf_io_initialize_output nf90_def_var Gmass_varid" ) + + if (param%lrhill_present) then + call netcdf_io_check( nf90_def_var(nc%id, nc%rhill_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%rhill_varid), "netcdf_io_initialize_output nf90_def_var rhill_varid" ) + end if + + if (param%lclose) then + call netcdf_io_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "netcdf_io_initialize_output nf90_def_var radius_varid" ) + + call netcdf_io_check( nf90_def_var(nc%id, nc%origin_time_varname, nc%out_type, nc%name_dimid, nc%origin_time_varid), "netcdf_io_initialize_output nf90_def_var origin_time_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%origin_type_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], & + nc%origin_type_varid), "netcdf_io_initialize_output nf90_create" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%origin_rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%origin_rh_varid), "netcdf_io_initialize_output nf90_def_var origin_rh_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%origin_vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%origin_vh_varid), "netcdf_io_initialize_output nf90_def_var origin_vh_varid" ) + + call netcdf_io_check( nf90_def_var(nc%id, nc%collision_id_varname, NF90_INT, nc%name_dimid, nc%collision_id_varid), "netcdf_io_initialize_output nf90_def_var collision_id_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%discard_time_varname, nc%out_type, nc%name_dimid, nc%discard_time_varid), "netcdf_io_initialize_output nf90_def_var discard_time_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%discard_rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%discard_rh_varid), "netcdf_io_initialize_output nf90_def_var discard_rh_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%discard_vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%discard_vh_varid), "netcdf_io_initialize_output nf90_def_var discard_vh_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%discard_body_id_varname, NF90_INT, nc%name_dimid, nc%discard_body_id_varid), "netcdf_io_initialize_output nf90_def_var discard_body_id_varid" ) + end if + + 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%time_dimid], nc%Ip_varid), "netcdf_io_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%time_dimid], nc%rot_varid), "netcdf_io_initialize_output nf90_def_var rot_varid" ) + end if + + ! if (param%ltides) then + ! call netcdf_io_check( nf90_def_var(nc%id, nc%k2_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%k2_varid), "netcdf_io_initialize_output nf90_def_var k2_varid" ) + ! call netcdf_io_check( nf90_def_var(nc%id, nc%q_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Q_varid), "netcdf_io_initialize_output nf90_def_var Q_varid" ) + ! end if + + if (param%lenergy) then + call netcdf_io_check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type, nc%time_dimid, nc%KE_orb_varid), "netcdf_io_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%time_dimid, nc%KE_spin_varid), "netcdf_io_initialize_output nf90_def_var KE_spin_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type, nc%time_dimid, nc%PE_varid), "netcdf_io_initialize_output nf90_def_var PE_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%be_varname, nc%out_type, nc%time_dimid, nc%BE_varid), "netcdf_io_initialize_output nf90_def_var PE_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_orb_varid), "netcdf_io_initialize_output nf90_def_var L_orb_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%Lspin_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%Lspin_varid), "netcdf_io_initialize_output nf90_def_var Lspin_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%L_escape_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_escape_varid), "netcdf_io_initialize_output nf90_def_var L_escape_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%Ecollisions_varname, nc%out_type, nc%time_dimid, nc%Ecollisions_varid), "netcdf_io_initialize_output nf90_def_var Ecollisions_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%Euntracked_varname, nc%out_type, nc%time_dimid, nc%Euntracked_varid), "netcdf_io_initialize_output nf90_def_var Euntracked_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%GMescape_varname, nc%out_type, nc%time_dimid, nc%GMescape_varid), "netcdf_io_initialize_output nf90_def_var GMescape_varid" ) + end if + + call netcdf_io_check( nf90_def_var(nc%id, nc%j2rp2_varname, nc%out_type, nc%time_dimid, nc%j2rp2_varid), "netcdf_io_initialize_output nf90_def_var j2rp2_varid" ) + 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" ) + + + ! 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 + call netcdf_io_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "netcdf_io_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), "netcdf_io_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), "netcdf_io_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), "netcdf_io_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), "netcdf_io_initialize_output nf90_def_var_fill NF90_CHAR" ) + end select + end do + + ! Set special fill mode for discard time so that we can make use of it for non-discarded bodies. + select case (vartype) + case(NF90_FLOAT) + call netcdf_io_check( nf90_def_var_fill(nc%id, nc%discard_time_varid, NO_FILL, huge(1.0_SP)), "netcdf_io_initialize_output nf90_def_var_fill discard_time NF90_FLOAT" ) + case(NF90_DOUBLE) + call netcdf_io_check( nf90_def_var_fill(nc%id, nc%discard_time_varid, NO_FILL, huge(1.0_DP)), "netcdf_io_initialize_output nf90_def_var_fill discard_time NF90_DOUBLE" ) + end select + + ! Take the file out of define mode + call netcdf_io_check( nf90_enddef(nc%id), "netcdf_io_initialize_output nf90_enddef" ) + + ! Add in the space dimension coordinates + call netcdf_io_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "netcdf_io_initialize_output nf90_put_var space" ) + + end associate + return + + 667 continue + write(*,*) "Error creating NetCDF output file. " // trim(adjustl(errmsg)) + call util_exit(FAILURE) + end subroutine swiftest_io_netcdf_initialize_output + + + module subroutine swiftest_io_netcdf_open(self, param, readonly) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Opens a NetCDF file and does the variable inquiries to activate variable ids + implicit none + ! Arguments + class(swiftest_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + logical, optional, intent(in) :: readonly !! Logical flag indicating that this should be open read only + ! Internals + integer(I4B) :: mode, status + character(len=STRMAX) :: errmsg + + mode = NF90_WRITE + if (present(readonly)) then + if (readonly) mode = NF90_NOWRITE + end if + + associate(nc => self) + + write(errmsg,*) "netcdf_io_open nf90_open ",trim(adjustl(nc%file_name)) + call netcdf_io_check( nf90_open(nc%file_name, mode, nc%id), errmsg) + self%lfile_is_open = .true. + + ! Dimensions + call netcdf_io_check( nf90_inq_dimid(nc%id, nc%time_dimname, nc%time_dimid), "netcdf_io_open nf90_inq_dimid time_dimid" ) + call netcdf_io_check( nf90_inq_dimid(nc%id, nc%space_dimname, nc%space_dimid), "netcdf_io_open nf90_inq_dimid space_dimid" ) + call netcdf_io_check( nf90_inq_dimid(nc%id, nc%name_dimname, nc%name_dimid), "netcdf_io_open nf90_inq_dimid name_dimid" ) + call netcdf_io_check( nf90_inq_dimid(nc%id, nc%str_dimname, nc%str_dimid), "netcdf_io_open nf90_inq_dimid str_dimid" ) + + ! Dimension coordinates + call netcdf_io_check( nf90_inq_varid(nc%id, nc%time_dimname, nc%time_varid), "netcdf_io_open nf90_inq_varid time_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%space_dimname, nc%space_varid), "netcdf_io_open nf90_inq_varid space_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%name_dimname, nc%name_varid), "netcdf_io_open nf90_inq_varid name_varid" ) + + ! Required Variables + call netcdf_io_check( nf90_inq_varid(nc%id, nc%id_varname, nc%id_varid), "netcdf_io_open nf90_inq_varid name_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%gmass_varname, nc%Gmass_varid), "netcdf_io_open nf90_inq_varid Gmass_varid" ) + + if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then + call netcdf_io_check( nf90_inq_varid(nc%id, nc%rh_varname, nc%rh_varid), "netcdf_io_open nf90_inq_varid rh_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%vh_varname, nc%vh_varid), "netcdf_io_open nf90_inq_varid vh_varid" ) + + if (param%lgr) then + !! check if pseudovelocity vectors exist in this file. If they are, set the correct flag so we know whe should not do the conversion. + status = nf90_inq_varid(nc%id, nc%gr_pseudo_vh_varname, nc%gr_pseudo_vh_varid) + nc%lpseudo_vel_exists = (status == nf90_noerr) + if (param%lrestart .and. .not.nc%lpseudo_vel_exists) then + write(*,*) "Warning! Pseudovelocity not found in input file for GR enabled run. If this is a restarted run, bit-identical trajectories are not guarunteed!" + end if + + end if + end if + + if ((param%out_form == "EL") .or. (param%out_form == "XVEL")) then + call netcdf_io_check( nf90_inq_varid(nc%id, nc%a_varname, nc%a_varid), "netcdf_io_open nf90_inq_varid a_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%e_varname, nc%e_varid), "netcdf_io_open nf90_inq_varid e_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%inc_varname, nc%inc_varid), "netcdf_io_open nf90_inq_varid inc_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%capom_varname, nc%capom_varid), "netcdf_io_open nf90_inq_varid capom_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%omega_varname, nc%omega_varid), "netcdf_io_open nf90_inq_varid omega_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%capm_varname, nc%capm_varid), "netcdf_io_open nf90_inq_varid capm_varid" ) + end if + + if (param%lclose) then + call netcdf_io_check( nf90_inq_varid(nc%id, nc%radius_varname, nc%radius_varid), "netcdf_io_open nf90_inq_varid radius_varid" ) + end if + + if (param%lrotation) then + call netcdf_io_check( nf90_inq_varid(nc%id, nc%Ip_varname, nc%Ip_varid), "netcdf_io_open nf90_inq_varid Ip_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%rot_varname, nc%rot_varid), "netcdf_io_open nf90_inq_varid rot_varid" ) + end if + + ! if (param%ltides) then + ! call netcdf_io_check( nf90_inq_varid(nc%id, nc%k2_varname, nc%k2_varid), "netcdf_io_open nf90_inq_varid k2_varid" ) + ! call netcdf_io_check( nf90_inq_varid(nc%id, nc%q_varname, nc%Q_varid), "netcdf_io_open nf90_inq_varid Q_varid" ) + ! end if + + ! Optional Variables + if (param%lrhill_present) then + status = nf90_inq_varid(nc%id, nc%rhill_varname, nc%rhill_varid) + if (status /= nf90_noerr) write(*,*) "Warning! RHILL variable not set in input file. Calculating." + end if + + ! Optional variables The User Doesn't Need to Know About + status = nf90_inq_varid(nc%id, nc%npl_varname, nc%npl_varid) + status = nf90_inq_varid(nc%id, nc%ntp_varname, nc%ntp_varid) + status = nf90_inq_varid(nc%id, nc%j2rp2_varname, nc%j2rp2_varid) + status = nf90_inq_varid(nc%id, nc%j4rp4_varname, nc%j4rp4_varid) + status = nf90_inq_varid(nc%id, nc%ptype_varname, nc%ptype_varid) + status = nf90_inq_varid(nc%id, nc%varpi_varname, nc%varpi_varid) + status = nf90_inq_varid(nc%id, nc%lam_varname, nc%lam_varid) + status = nf90_inq_varid(nc%id, nc%f_varname, nc%f_varid) + status = nf90_inq_varid(nc%id, nc%cape_varname, nc%cape_varid) + + if (param%lmtiny_pl) status = nf90_inq_varid(nc%id, nc%nplm_varname, nc%nplm_varid) + + if (param%lclose) then + status = nf90_inq_varid(nc%id, nc%origin_type_varname, nc%origin_type_varid) + status = nf90_inq_varid(nc%id, nc%origin_time_varname, nc%origin_time_varid) + status = nf90_inq_varid(nc%id, nc%origin_rh_varname, nc%origin_rh_varid) + status = nf90_inq_varid(nc%id, nc%origin_vh_varname, nc%origin_vh_varid) + status = nf90_inq_varid(nc%id, nc%collision_id_varname, nc%collision_id_varid) + status = nf90_inq_varid(nc%id, nc%discard_time_varname, nc%discard_time_varid) + status = nf90_inq_varid(nc%id, nc%discard_rh_varname, nc%discard_rh_varid) + status = nf90_inq_varid(nc%id, nc%discard_vh_varname, nc%discard_vh_varid) + status = nf90_inq_varid(nc%id, nc%discard_body_id_varname, nc%discard_body_id_varid) + end if + + if (param%lenergy) then + status = nf90_inq_varid(nc%id, nc%ke_orb_varname, nc%KE_orb_varid) + status = nf90_inq_varid(nc%id, nc%ke_spin_varname, nc%KE_spin_varid) + status = nf90_inq_varid(nc%id, nc%pe_varname, nc%PE_varid) + status = nf90_inq_varid(nc%id, nc%be_varname, nc%BE_varid) + status = nf90_inq_varid(nc%id, nc%L_orb_varname, nc%L_orb_varid) + status = nf90_inq_varid(nc%id, nc%Lspin_varname, nc%Lspin_varid) + status = nf90_inq_varid(nc%id, nc%L_escape_varname, nc%L_escape_varid) + status = nf90_inq_varid(nc%id, nc%Ecollisions_varname, nc%Ecollisions_varid) + status = nf90_inq_varid(nc%id, nc%Euntracked_varname, nc%Euntracked_varid) + status = nf90_inq_varid(nc%id, nc%GMescape_varname, nc%GMescape_varid) + end if + + end associate + + return + end subroutine swiftest_io_netcdf_open + + + module function swiftest_io_netcdf_read_frame_system(self, nc, param) result(ierr) + !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Read a frame (header plus records for each massive body and active test particle) from an output binary file + implicit none + ! Arguments + 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 + ! Return + integer(I4B) :: ierr !! Error code: returns 0 if the read is successful + ! Internals + integer(I4B) :: i, tslot, idmax, npl_check, ntp_check, nplm_check, t_max, str_max, status + real(DP), dimension(:), allocatable :: rtemp + real(DP), dimension(:,:), allocatable :: vectemp + integer(I4B), dimension(:), allocatable :: itemp + logical, dimension(:), allocatable :: validmask, tpmask, plmask + + tslot = param%ioutput + + call nc%open(param, readonly=.true.) + call self%read_hdr(nc, param) + associate(cb => self%cb, pl => self%pl, tp => self%tp, npl => self%pl%nbody, ntp => self%tp%nbody) + + call pl%setup(npl, param) + call tp%setup(ntp, param) + + call netcdf_io_check( nf90_inquire_dimension(nc%id, nc%name_dimid, len=idmax), "netcdf_io_read_frame_system nf90_inquire_dimension name_dimid" ) + allocate(rtemp(idmax)) + allocate(vectemp(NDIM,idmax)) + allocate(itemp(idmax)) + allocate(validmask(idmax)) + allocate(tpmask(idmax)) + allocate(plmask(idmax)) + call netcdf_io_check( nf90_inquire_dimension(nc%id, nc%time_dimid, len=t_max), "netcdf_io_read_frame_system nf90_inquire_dimension time_dimid" ) + call netcdf_io_check( nf90_inquire_dimension(nc%id, nc%str_dimid, len=str_max), "netcdf_io_read_frame_system nf90_inquire_dimension str_dimid" ) + + ! First filter out only the id slots that contain valid bodies + if (param%in_form == "XV") then + call netcdf_io_check( nf90_get_var(nc%id, nc%rh_varid, vectemp(:,:), start=[1, 1, tslot]), "netcdf_io_read_frame_system filter pass nf90_getvar rh_varid" ) + validmask(:) = vectemp(1,:) == vectemp(1,:) + else + call netcdf_io_check( nf90_get_var(nc%id, nc%a_varid, rtemp(:), start=[1, tslot]), "netcdf_io_read_frame_system filter pass nf90_getvar a_varid" ) + validmask(:) = rtemp(:) == rtemp(:) + end if + + ! Next, filter only bodies that don't have mass (test particles) + call netcdf_io_check( nf90_get_var(nc%id, nc%Gmass_varid, rtemp(:), start=[1, tslot]), "netcdf_io_read_frame_system nf90_getvar tp finder Gmass_varid" ) + plmask(:) = rtemp(:) == rtemp(:) .and. validmask(:) + tpmask(:) = .not. plmask(:) .and. validmask(:) + plmask(1) = .false. ! This is the central body + + ! Check to make sure the number of bodies is correct + npl_check = count(plmask(:)) + ntp_check = count(tpmask(:)) + + if (npl_check /= npl) then + write(*,*) "Error reading in NetCDF file: The recorded value of npl does not match the number of active massive bodies" + call util_exit(failure) + end if + + if (ntp_check /= ntp) then + write(*,*) "Error reading in NetCDF file: The recorded value of ntp does not match the number of active test particles" + call util_exit(failure) + end if + + if (param%lmtiny_pl) then + nplm_check = count(pack(rtemp,plmask) > param%GMTINY ) + if (nplm_check /= pl%nplm) then + write(*,*) "Error reading in NetCDF file: The recorded value of nplm does not match the number of active fully interacting massive bodies" + call util_exit(failure) + end if + end if + + ! Now read in each variable and split the outputs by body type + if ((param%in_form == "XV") .or. (param%in_form == "XVEL")) then + call netcdf_io_check( nf90_get_var(nc%id, nc%rh_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "netcdf_io_read_frame_system nf90_getvar rh_varid" ) + do i = 1, NDIM + if (npl > 0) pl%rh(i,:) = pack(vectemp(i,:), plmask(:)) + if (ntp > 0) tp%rh(i,:) = pack(vectemp(i,:), tpmask(:)) + end do + + if (param%lgr .and. nc%lpseudo_vel_exists) then + call netcdf_io_check( nf90_get_var(nc%id, nc%gr_pseudo_vh_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "netcdf_io_read_frame_system nf90_getvar gr_pseudo_vh_varid" ) + do i = 1, NDIM + if (npl > 0) pl%vh(i,:) = pack(vectemp(i,:), plmask(:)) + if (ntp > 0) tp%vh(i,:) = pack(vectemp(i,:), tpmask(:)) + end do + else + call netcdf_io_check( nf90_get_var(nc%id, nc%vh_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "netcdf_io_read_frame_system nf90_getvar vh_varid" ) + do i = 1, NDIM + if (npl > 0) pl%vh(i,:) = pack(vectemp(i,:), plmask(:)) + if (ntp > 0) tp%vh(i,:) = pack(vectemp(i,:), tpmask(:)) + end do + end if + end if + + if ((param%in_form == "EL") .or. (param%in_form == "XVEL")) then + call netcdf_io_check( nf90_get_var(nc%id, nc%a_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_io_read_frame_system nf90_getvar a_varid" ) + if (.not.allocated(pl%a)) allocate(pl%a(npl)) + if (.not.allocated(tp%a)) allocate(tp%a(ntp)) + if (npl > 0) pl%a(:) = pack(rtemp, plmask) + if (ntp > 0) tp%a(:) = pack(rtemp, tpmask) + + call netcdf_io_check( nf90_get_var(nc%id, nc%e_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_io_read_frame_system nf90_getvar e_varid" ) + if (.not.allocated(pl%e)) allocate(pl%e(npl)) + if (.not.allocated(tp%e)) allocate(tp%e(ntp)) + if (npl > 0) pl%e(:) = pack(rtemp, plmask) + if (ntp > 0) tp%e(:) = pack(rtemp, tpmask) + + call netcdf_io_check( nf90_get_var(nc%id, nc%inc_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_io_read_frame_system nf90_getvar inc_varid" ) + rtemp = rtemp * DEG2RAD + if (.not.allocated(pl%inc)) allocate(pl%inc(npl)) + if (.not.allocated(tp%inc)) allocate(tp%inc(ntp)) + if (npl > 0) pl%inc(:) = pack(rtemp, plmask) + if (ntp > 0) tp%inc(:) = pack(rtemp, tpmask) + + call netcdf_io_check( nf90_get_var(nc%id, nc%capom_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_io_read_frame_system nf90_getvar capom_varid" ) + rtemp = rtemp * DEG2RAD + if (.not.allocated(pl%capom)) allocate(pl%capom(npl)) + if (.not.allocated(tp%capom)) allocate(tp%capom(ntp)) + if (npl > 0) pl%capom(:) = pack(rtemp, plmask) + if (ntp > 0) tp%capom(:) = pack(rtemp, tpmask) + + call netcdf_io_check( nf90_get_var(nc%id, nc%omega_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_io_read_frame_system nf90_getvar omega_varid" ) + rtemp = rtemp * DEG2RAD + if (.not.allocated(pl%omega)) allocate(pl%omega(npl)) + if (.not.allocated(tp%omega)) allocate(tp%omega(ntp)) + if (npl > 0) pl%omega(:) = pack(rtemp, plmask) + if (ntp > 0) tp%omega(:) = pack(rtemp, tpmask) + + call netcdf_io_check( nf90_get_var(nc%id, nc%capm_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_io_read_frame_system nf90_getvar capm_varid" ) + rtemp = rtemp * DEG2RAD + if (.not.allocated(pl%capm)) allocate(pl%capm(npl)) + if (.not.allocated(tp%capm)) allocate(tp%capm(ntp)) + if (npl > 0) pl%capm(:) = pack(rtemp, plmask) + if (ntp > 0) tp%capm(:) = pack(rtemp, tpmask) + + end if + + call netcdf_io_check( nf90_get_var(nc%id, nc%Gmass_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_io_read_frame_system nf90_getvar Gmass_varid" ) + cb%Gmass = rtemp(1) + cb%mass = cb%Gmass / param%GU + + ! Set initial central body mass for Helio bookkeeping + cb%GM0 = cb%Gmass + + + if (npl > 0) then + pl%Gmass(:) = pack(rtemp, plmask) + pl%mass(:) = pl%Gmass(:) / param%GU + + if (param%lrhill_present) then + call netcdf_io_check( nf90_get_var(nc%id, nc%rhill_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_io_read_frame_system nf90_getvar rhill_varid" ) + pl%rhill(:) = pack(rtemp, plmask) + end if + end if + + if (param%lclose) then + call netcdf_io_check( nf90_get_var(nc%id, nc%radius_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_io_read_frame_system nf90_getvar radius_varid" ) + cb%radius = rtemp(1) + + ! Set initial central body radius for SyMBA bookkeeping + cb%R0 = cb%radius + if (npl > 0) pl%radius(:) = pack(rtemp, plmask) + else + cb%radius = param%rmin + if (npl > 0) pl%radius(:) = 0.0_DP + end if + + if (param%lrotation) then + call netcdf_io_check( nf90_get_var(nc%id, nc%Ip_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "netcdf_io_read_frame_system nf90_getvar Ip_varid" ) + cb%Ip(:) = vectemp(:,1) + do i = 1, NDIM + if (npl > 0) pl%Ip(i,:) = pack(vectemp(i,:), plmask(:)) + end do + + call netcdf_io_check( nf90_get_var(nc%id, nc%rot_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "netcdf_io_read_frame_system nf90_getvar rot_varid" ) + cb%rot(:) = vectemp(:,1) + do i = 1, NDIM + if (npl > 0) pl%rot(i,:) = pack(vectemp(i,:), plmask(:)) + end do + + ! Set initial central body angular momentum for bookkeeping + cb%L0(:) = cb%Ip(3) * cb%GM0 * cb%R0**2 * cb%rot(:) + end if + + ! if (param%ltides) then + ! call netcdf_io_check( nf90_get_var(nc%id, nc%k2_varid, rtemp, start=[1, tslot]), "netcdf_io_read_frame_system nf90_getvar k2_varid" ) + ! cb%k2 = rtemp(1) + ! if (npl > 0) pl%k2(:) = pack(rtemp, plmask) + + ! call netcdf_io_check( nf90_get_var(nc%id, nc%Q_varid, rtemp, start=[1, tslot]), "netcdf_io_read_frame_system nf90_getvar Q_varid" ) + ! cb%Q = rtemp(1) + ! if (npl > 0) pl%Q(:) = pack(rtemp, plmask) + ! end if + + status = nf90_inq_varid(nc%id, nc%j2rp2_varname, nc%j2rp2_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%j2rp2_varid, cb%j2rp2, start=[tslot]), "netcdf_io_read_frame_system nf90_getvar j2rp2_varid" ) + else + cb%j2rp2 = 0.0_DP + end if + + status = nf90_inq_varid(nc%id, nc%j4rp4_varname, nc%j4rp4_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%j4rp4_varid, cb%j4rp4, start=[tslot]), "netcdf_io_read_frame_system nf90_getvar j4rp4_varid" ) + else + cb%j4rp4 = 0.0_DP + end if + + call self%read_particle_info(nc, param, plmask, tpmask) + + if (param%in_form == "EL") then + call pl%el2xv(cb) + call tp%el2xv(cb) + end if + ! if this is a GR-enabled run, check to see if we got the pseudovelocities in. Otherwise, we'll need to generate them. + if (param%lgr .and. .not.(nc%lpseudo_vel_exists)) then + call pl%set_mu(cb) + call tp%set_mu(cb) + call pl%v2pv(param) + call tp%v2pv(param) + end if + + end associate + + call nc%close() + + ierr = 0 + return + + 667 continue + write(*,*) "Error reading nbody_system frame in netcdf_io_read_frame_system" + + end function swiftest_io_netcdf_read_frame_system + + + module subroutine swiftest_io_netcdf_read_hdr_system(self, nc, param) + !! author: David A. Minton + !! + !! Reads header information (variables that change with time, but not particle id). + !! This subroutine swiftest_significantly improves the output over the original binary file, allowing us to track energy, momentum, and other quantities that + !! previously were handled as separate output files. + implicit none + ! Arguments + 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 + ! Internals + integer(I4B) :: tslot, status, idmax + real(DP), dimension(:), allocatable :: gmtemp + logical, dimension(:), allocatable :: plmask, tpmask, plmmask + + + tslot = param%ioutput + call netcdf_io_check( nf90_inquire_dimension(nc%id, nc%name_dimid, len=idmax), "netcdf_io_read_hdr_system nf90_inquire_dimension name_dimid" ) + call netcdf_io_check( nf90_get_var(nc%id, nc%time_varid, self%t, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar time_varid" ) + + allocate(gmtemp(idmax)) + allocate(tpmask(idmax)) + allocate(plmask(idmax)) + allocate(plmmask(idmax)) + + call netcdf_io_check( nf90_get_var(nc%id, nc%Gmass_varid, gmtemp, start=[1,1], count=[idmax,1]), "netcdf_io_read_hdr_system nf90_getvar Gmass_varid" ) + + plmask(:) = gmtemp(:) == gmtemp(:) + tpmask(:) = .not. plmask(:) + plmask(1) = .false. ! This is the central body + plmmask(:) = plmask(:) + + if (param%lmtiny_pl) then + where(plmask(:)) + plmmask(:) = gmtemp(:) > param%GMTINY + endwhere + end if + + status = nf90_inq_varid(nc%id, nc%npl_varname, nc%npl_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%npl_varid, self%pl%nbody, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar npl_varid" ) + else + self%pl%nbody = count(plmask(:)) + end if + + status = nf90_inq_varid(nc%id, nc%ntp_varname, nc%ntp_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%ntp_varid, self%tp%nbody, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar ntp_varid" ) + else + self%tp%nbody = count(tpmask(:)) + end if + + if (param%lmtiny_pl) then + status = nf90_inq_varid(nc%id, nc%nplm_varname, nc%nplm_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%nplm_varid, self%pl%nplm, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar nplm_varid" ) + else + self%pl%nplm = count(plmmask(:)) + end if + end if + + if (param%lenergy) then + status = nf90_inq_varid(nc%id, nc%ke_orb_varname, nc%KE_orb_varid) + if (status == nf90_noerr) call netcdf_io_check( nf90_get_var(nc%id, nc%KE_orb_varid, self%ke_orbit, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar KE_orb_varid" ) + status = nf90_inq_varid(nc%id, nc%ke_spin_varname, nc%KE_spin_varid) + if (status == nf90_noerr) call netcdf_io_check( nf90_get_var(nc%id, nc%KE_spin_varid, self%ke_spin, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar KE_spin_varid" ) + status = nf90_inq_varid(nc%id, nc%pe_varname, nc%PE_varid) + if (status == nf90_noerr) call netcdf_io_check( nf90_get_var(nc%id, nc%PE_varid, self%pe, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar PE_varid" ) + status = nf90_inq_varid(nc%id, nc%be_varname, nc%BE_varid) + if (status == nf90_noerr) call netcdf_io_check( nf90_get_var(nc%id, nc%BE_varid, self%be, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar BE_varid" ) + status = nf90_inq_varid(nc%id, nc%L_orb_varname, nc%L_orb_varid) + if (status == nf90_noerr) call netcdf_io_check( nf90_get_var(nc%id, nc%L_orb_varid, self%Lorbit(:), start=[1,tslot], count=[NDIM,1]), "netcdf_io_read_hdr_system nf90_getvar L_orb_varid" ) + status = nf90_inq_varid(nc%id, nc%Lspin_varname, nc%Lspin_varid) + if (status == nf90_noerr) call netcdf_io_check( nf90_get_var(nc%id, nc%Lspin_varid, self%Lspin(:), start=[1,tslot], count=[NDIM,1]), "netcdf_io_read_hdr_system nf90_getvar Lspin_varid" ) + status = nf90_inq_varid(nc%id, nc%L_escape_varname, nc%L_escape_varid) + if (status == nf90_noerr) call netcdf_io_check( nf90_get_var(nc%id, nc%L_escape_varid, self%Lescape(:), start=[1, tslot], count=[NDIM,1]), "netcdf_io_read_hdr_system nf90_getvar L_escape_varid" ) + status = nf90_inq_varid(nc%id, nc%Ecollisions_varname, nc%Ecollisions_varid) + if (status == nf90_noerr) call netcdf_io_check( nf90_get_var(nc%id, nc%Ecollisions_varid, self%Ecollisions, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar Ecollisions_varid" ) + status = nf90_inq_varid(nc%id, nc%Euntracked_varname, nc%Euntracked_varid) + if (status == nf90_noerr) call netcdf_io_check( nf90_get_var(nc%id, nc%Euntracked_varid, self%Euntracked, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar Euntracked_varid" ) + status = nf90_inq_varid(nc%id, nc%GMescape_varname, nc%GMescape_varid) + if (status == nf90_noerr) call netcdf_io_check( nf90_get_var(nc%id, nc%GMescape_varid, self%GMescape, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar GMescape_varid" ) + end if + + return + end subroutine swiftest_io_netcdf_read_hdr_system + + + module subroutine swiftest_io_netcdf_read_particle_info_system(self, nc, param, plmask, tpmask) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Reads particle information metadata from file + implicit none + ! Arguments + 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 + + ! Internals + integer(I4B) :: i, idmax, status + real(DP), dimension(:), allocatable :: rtemp + real(DP), dimension(:,:), allocatable :: vectemp + integer(I4B), dimension(:), allocatable :: itemp + character(len=NAMELEN), dimension(:), allocatable :: ctemp + integer(I4B), dimension(:), allocatable :: plind, tpind + + ! This string of spaces of length NAMELEN is used to clear out any old data left behind inside the string variables + idmax = size(plmask) + allocate(rtemp(idmax)) + allocate(vectemp(NDIM,idmax)) + allocate(itemp(idmax)) + allocate(ctemp(idmax)) + + associate(cb => self%cb, pl => self%pl, tp => self%tp, npl => self%pl%nbody, ntp => self%tp%nbody) + + if (npl > 0) then + pl%status(:) = ACTIVE + pl%lmask(:) = .true. + do i = 1, npl + call pl%info(i)%set_value(status="ACTIVE") + end do + allocate(plind(npl)) + plind(:) = pack([(i, i = 1, idmax)], plmask(:)) + end if + if (ntp > 0) then + tp%status(:) = ACTIVE + tp%lmask(:) = .true. + do i = 1, ntp + call tp%info(i)%set_value(status="ACTIVE") + end do + allocate(tpind(ntp)) + tpind(:) = pack([(i, i = 1, idmax)], tpmask(:)) + end if + + call netcdf_io_check( nf90_get_var(nc%id, nc%id_varid, itemp), "netcdf_io_read_particle_info_system nf90_getvar id_varid" ) + cb%id = itemp(1) + pl%id(:) = pack(itemp, plmask) + tp%id(:) = pack(itemp, tpmask) + cb%id = 0 + pl%id(:) = pack([(i,i=0,idmax-1)],plmask) + tp%id(:) = pack([(i,i=0,idmax-1)],tpmask) + + call netcdf_io_check( nf90_get_var(nc%id, nc%name_varid, ctemp, count=[NAMELEN, idmax]), "netcdf_io_read_particle_info_system nf90_getvar name_varid" ) + call cb%info%set_value(name=ctemp(1)) + do i = 1, npl + call pl%info(i)%set_value(name=ctemp(plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(name=ctemp(tpind(i))) + end do + + status = nf90_get_var(nc%id, nc%ptype_varid, ctemp, count=[NAMELEN, idmax]) + if (status /= nf90_noerr) then ! Set default particle types + call cb%info%set_value(particle_type=CB_TYPE_NAME) + + ! Handle semi-interacting bodies in SyMBA + do i = 1, npl + if (param%lmtiny_pl .and. (pl%Gmass(i) < param%GMTINY)) then + call pl%info(i)%set_value(particle_type=PL_TINY_TYPE_NAME) + else + call pl%info(i)%set_value(particle_type=PL_TYPE_NAME) + end if + end do + do i = 1, ntp + call tp%info(i)%set_value(particle_type=TP_TYPE_NAME) + end do + else ! Use particle types defined in input file + call cb%info%set_value(particle_type=ctemp(1)) + do i = 1, npl + call pl%info(i)%set_value(particle_type=ctemp(plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(particle_type=ctemp(tpind(i))) + end do + end if + + call cb%info%set_value(status="ACTIVE") + + if (param%lclose) then + + status = nf90_inq_varid(nc%id, nc%origin_type_varname, nc%origin_type_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%origin_type_varid, ctemp, count=[NAMELEN, idmax]), "netcdf_io_read_particle_info_system nf90_getvar origin_type_varid" ) + else + ctemp = "Initial Conditions" + end if + + call cb%info%set_value(origin_type=ctemp(1)) + do i = 1, npl + call pl%info(i)%set_value(origin_type=ctemp(plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(origin_type=ctemp(tpind(i))) + end do + + status = nf90_inq_varid(nc%id, nc%origin_time_varname, nc%origin_time_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%origin_time_varid, rtemp), "netcdf_io_read_particle_info_system nf90_getvar origin_time_varid" ) + else + rtemp = param%t0 + end if + + call cb%info%set_value(origin_time=rtemp(1)) + do i = 1, npl + call pl%info(i)%set_value(origin_time=rtemp(plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(origin_time=rtemp(tpind(i))) + end do + + status = nf90_inq_varid(nc%id, nc%origin_rh_varname, nc%origin_rh_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%origin_rh_varid, vectemp(:,:)), "netcdf_io_read_particle_info_system nf90_getvar origin_rh_varid" ) + else if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then + call netcdf_io_check( nf90_get_var(nc%id, nc%rh_varid, vectemp(:,:)), "netcdf_io_read_particle_info_system nf90_getvar rh_varid" ) + else + vectemp(:,:) = 0._DP + end if + + do i = 1, npl + call pl%info(i)%set_value(origin_rh=vectemp(:,plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(origin_rh=vectemp(:,tpind(i))) + end do + + status = nf90_inq_varid(nc%id, nc%origin_vh_varname, nc%origin_vh_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%origin_vh_varid, vectemp(:,:)), "netcdf_io_read_particle_info_system nf90_getvar origin_vh_varid" ) + else if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then + call netcdf_io_check( nf90_get_var(nc%id, nc%vh_varid, vectemp(:,:)), "netcdf_io_read_particle_info_system nf90_getvar vh_varid" ) + else + vectemp(:,:) = 0._DP + end if + + do i = 1, npl + call pl%info(i)%set_value(origin_vh=vectemp(:,plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(origin_vh=vectemp(:,tpind(i))) + end do + + status = nf90_inq_varid(nc%id, nc%collision_id_varname, nc%collision_id_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%collision_id_varid, itemp), "netcdf_io_read_particle_info_system nf90_getvar collision_id_varid" ) + else + itemp = 0 + end if + + do i = 1, npl + call pl%info(i)%set_value(collision_id=itemp(plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(collision_id=itemp(tpind(i))) + end do + + status = nf90_inq_varid(nc%id, nc%discard_time_varname, nc%discard_time_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%discard_time_varid, rtemp), "netcdf_io_read_particle_info_system nf90_getvar discard_time_varid" ) + else + select case (param%out_type) + case("netcdf_io_FLOAT") + rtemp(:) = huge(0.0_SP) + case("netcdf_io_DOUBLE") + rtemp(:) = huge(0.0_DP) + end select + end if + + call cb%info%set_value(discard_time=rtemp(1)) + do i = 1, npl + call pl%info(i)%set_value(discard_time=rtemp(plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(discard_time=rtemp(tpind(i))) + end do + + status = nf90_inq_varid(nc%id, nc%discard_rh_varname, nc%discard_rh_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%discard_rh_varid, vectemp(:,:)), "netcdf_io_read_particle_info_system nf90_getvar discard_rh_varid" ) + else + vectemp(:,:) = 0.0_DP + end if + + do i = 1, npl + call pl%info(i)%set_value(discard_rh=vectemp(:,plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(discard_rh=vectemp(:,tpind(i))) + end do + + status = nf90_inq_varid(nc%id, nc%discard_vh_varname, nc%discard_vh_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%discard_vh_varid, vectemp(:,:)), "netcdf_io_read_particle_info_system nf90_getvar discard_vh_varid" ) + else + vectemp(:,:) = 0.0_DP + end if + + do i = 1, npl + call pl%info(i)%set_value(discard_vh=vectemp(:,plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(discard_vh=vectemp(:,tpind(i))) + end do + end if + + end associate + + return + end subroutine swiftest_io_netcdf_read_particle_info_system + + + module subroutine swiftest_io_netcdf_write_frame_body(self, nc, param) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Write a frame of output of either test particle or massive body data to the binary output file + !! Note: If outputting to orbital elements, but sure that the conversion is done prior to calling this method + implicit none + ! Arguments + 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 + ! Internals + integer(I4B) :: i, j, tslot, idslot, old_mode + integer(I4B), dimension(:), allocatable :: ind + real(DP), dimension(NDIM) :: vh !! Temporary variable to store heliocentric velocity values when converting from pseudovelocity in GR-enabled runs + real(DP) :: a, e, inc, omega, capom, capm, varpi, lam, f, cape, capf + + tslot = param%ioutput + + call self%write_info(nc, param) + + call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "netcdf_io_write_frame_body nf90_set_fill" ) + select type(self) + class is (swiftest_body) + select type (param) + class is (swiftest_parameters) + associate(n => self%nbody) + if (n == 0) return + + call swiftest_util_sort(self%id(1:n), ind) + + do i = 1, n + j = ind(i) + idslot = self%id(j) + 1 + + !! Convert from pseudovelocity to heliocentric without replacing the current value of pseudovelocity + if (param%lgr) call swiftest_gr_pseudovel2vel(param, self%mu(j), self%rh(:, j), self%vh(:, j), vh(:)) + + if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then + call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, self%rh(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "netcdf_io_write_frame_body nf90_put_var rh_varid" ) + if (param%lgr) then !! Convert from pseudovelocity to heliocentric without replacing the current value of pseudovelocity + call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, vh(:), start=[1,idslot, tslot], count=[NDIM,1,1]), "netcdf_io_write_frame_body nf90_put_var vh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%gr_pseudo_vh_varid, self%vh(:, j), start=[1,idslot, tslot],count=[NDIM,1,1]), "netcdf_io_write_frame_body nf90_put_var gr_pseudo_vhx_varid" ) + + else + call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, self%vh(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "netcdf_io_write_frame_body nf90_put_var vh_varid" ) + end if + end if + + if ((param%out_form == "EL") .or. (param%out_form == "XVEL")) then + if (param%lgr) then !! For GR-enabled runs, use the true value of velocity computed above + call swiftest_orbel_xv2el(self%mu(j), self%rh(1,j), self%rh(2,j), self%rh(3,j), & + vh(1), vh(2), vh(3), & + a, e, inc, capom, omega, capm, varpi, lam, f, cape, capf) + else !! For non-GR runs just convert from the velocity we have + call swiftest_orbel_xv2el(self%mu(j), self%rh(1,j), self%rh(2,j), self%rh(3,j), & + self%vh(1,j), self%vh(2,j), self%vh(3,j), & + a, e, inc, capom, omega, capm, varpi, lam, f, cape, capf) + end if + call netcdf_io_check( nf90_put_var(nc%id, nc%a_varid, a, start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body a_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%e_varid, e, start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body e_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%inc_varid, inc * RAD2DEG, start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body inc_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%capom_varid, capom * RAD2DEG, start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body capom_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%omega_varid, omega * RAD2DEG, start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body omega_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%capm_varid, capm * RAD2DEG, start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body capm_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%varpi_varid, varpi * RAD2DEG, start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body varpi_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%lam_varid, lam * RAD2DEG, start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body lam_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%f_varid, f * RAD2DEG, start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body f_varid" ) + if (e < 1.0_DP) then + call netcdf_io_check( nf90_put_var(nc%id, nc%cape_varid, cape * RAD2DEG, start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body cape_varid" ) + else if (e > 1.0_DP) then + call netcdf_io_check( nf90_put_var(nc%id, nc%cape_varid, capf * RAD2DEG, start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body (capf) cape_varid" ) + end if + end if + + select type(self) + class is (swiftest_pl) ! Additional output if the passed polymorphic object is a massive body + call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, self%Gmass(j), start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body Gmass_varid" ) + if (param%lrhill_present) then + call netcdf_io_check( nf90_put_var(nc%id, nc%rhill_varid, self%rhill(j), start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body rhill_varid" ) + end if + if (param%lclose) call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, self%radius(j), start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body radius_varid" ) + if (param%lrotation) then + call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, self%Ip(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "netcdf_io_write_frame_body nf90_put_var body Ip_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, self%rot(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "netcdf_io_write_frame_body nf90_put_var body rotx_varid" ) + end if + ! if (param%ltides) then + ! call netcdf_io_check( nf90_put_var(nc%id, nc%k2_varid, self%k2(j), start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body k2_varid" ) + ! call netcdf_io_check( nf90_put_var(nc%id, nc%Q_varid, self%Q(j), start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body Q_varid" ) + ! end if + + end select + end do + end associate + end select + end select + call netcdf_io_check( nf90_set_fill(nc%id, old_mode, old_mode), "netcdf_io_write_frame_body nf90_set_fill old_mode" ) + + return + end subroutine swiftest_io_netcdf_write_frame_body + + + module subroutine swiftest_io_netcdf_write_frame_cb(self, nc, param) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Write a frame of output of the central body + implicit none + ! Arguments + 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 + ! Internals + integer(I4B) :: i, j, tslot, idslot, old_mode + + tslot = param%ioutput + + call self%write_info(nc, param) + + call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "netcdf_io_write_frame_cb nf90_set_fill" ) + + idslot = self%id + 1 + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, self%id, start=[idslot]), "netcdf_io_write_frame_cb nf90_put_var cb id_varid" ) + + call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, self%Gmass, start=[idslot, tslot]), "netcdf_io_write_frame_cb nf90_put_var cb Gmass_varid" ) + if (param%lclose) call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, self%radius, start=[idslot, tslot]), "netcdf_io_write_frame_cb nf90_put_var cb radius_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%j2rp2_varid, self%j2rp2, start=[tslot]), "netcdf_io_write_frame_cb nf90_put_var cb j2rp2_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%j4rp4_varid, self%j4rp4, start=[tslot]), "netcdf_io_write_frame_cb nf90_put_var cb j4rp4_varid" ) + if (param%lrotation) then + call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, self%Ip(:), start=[1, idslot, tslot], count=[NDIM,1,1]), "netcdf_io_write_frame_cb nf90_put_var cb Ip_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, self%rot(:), start=[1, idslot, tslot], count=[NDIM,1,1]), "netcdf_io_write_frame_cby nf90_put_var cb rot_varid" ) + end if + + call netcdf_io_check( nf90_set_fill(nc%id, old_mode, old_mode), "netcdf_io_write_frame_cb nf90_set_fill old_mode" ) + + return + end subroutine swiftest_io_netcdf_write_frame_cb + + + module subroutine swiftest_io_netcdf_write_frame_system(self, nc, param) + !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Write a frame (header plus records for each massive body and active test particle) to a output binary file + implicit none + ! Arguments + 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 + + call self%write_hdr(nc, param) + call self%cb%write_frame(nc, param) + call self%pl%write_frame(nc, param) + call self%tp%write_frame(nc, param) + + return + end subroutine swiftest_io_netcdf_write_frame_system + + + module subroutine swiftest_io_netcdf_write_hdr_system(self, nc, param) + !! author: David A. Minton + !! + !! Writes header information (variables that change with time, but not particle id). + !! This subroutine swiftest_significantly improves the output over the original binary file, allowing us to track energy, momentum, and other quantities that + !! previously were handled as separate output files. + implicit none + ! Arguments + 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 + ! Internals + integer(I4B) :: tslot + + tslot = param%ioutput + + call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var time_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%npl_varid, self%pl%nbody, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var npl_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ntp_varid, self%tp%nbody, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var ntp_varid" ) + if (param%lmtiny_pl) call netcdf_io_check( nf90_put_var(nc%id, nc%nplm_varid, self%pl%nplm, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var nplm_varid" ) + + if (param%lenergy) then + call netcdf_io_check( nf90_put_var(nc%id, nc%KE_orb_varid, self%ke_orbit, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var KE_orb_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%KE_spin_varid, self%ke_spin, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var KE_spin_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%PE_varid, self%pe, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var PE_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%BE_varid, self%be, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var BE_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%L_orb_varid, self%Lorbit(:), start=[1,tslot], count=[NDIM,1]), "netcdf_io_write_hdr_system nf90_put_var L_orb_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Lspin_varid, self%Lspin(:), start=[1,tslot], count=[NDIM,1]), "netcdf_io_write_hdr_system nf90_put_var Lspin_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%L_escape_varid, self%Lescape(:), start=[1,tslot], count=[NDIM,1]), "netcdf_io_write_hdr_system nf90_put_var L_escape_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Ecollisions_varid, self%Ecollisions, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var Ecollisions_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Euntracked_varid, self%Euntracked, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var Euntracked_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%GMescape_varid, self%GMescape, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var GMescape_varid" ) + end if + + return + end subroutine swiftest_io_netcdf_write_hdr_system + + + module subroutine swiftest_io_netcdf_write_info_body(self, nc, param) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Write all current particle to file + implicit none + ! Arguments + 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 + ! Internals + integer(I4B) :: i, j, idslot, old_mode + integer(I4B), dimension(:), allocatable :: ind + character(len=:), allocatable :: charstring + + ! This string of spaces of length NAMELEN is used to clear out any old data left behind inside the string variables + call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "netcdf_io_write_info_body nf90_set_fill nf90_nofill" ) + + select type(self) + class is (swiftest_body) + associate(n => self%nbody) + if (n == 0) return + call swiftest_util_sort(self%id(1:n), ind) + + do i = 1, n + j = ind(i) + idslot = self%id(j) + 1 + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, self%id(j), start=[idslot]), "netcdf_io_write_info_body nf90_put_var id_varid" ) + + charstring = trim(adjustl(self%info(j)%name)) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_io_write_info_body nf90_put_var name_varid" ) + + charstring = trim(adjustl(self%info(j)%particle_type)) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_io_write_info_body nf90_put_var particle_type_varid" ) + + if (param%lclose) then + charstring = trim(adjustl(self%info(j)%origin_type)) + call netcdf_io_check( nf90_put_var(nc%id, nc%origin_type_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_io_write_info_body nf90_put_var origin_type_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%origin_time_varid, self%info(j)%origin_time, start=[idslot]), "netcdf_io_write_info_body nf90_put_var origin_time_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%origin_rh_varid, self%info(j)%origin_rh(:), start=[1,idslot], count=[NDIM,1]), "netcdf_io_write_info_body nf90_put_var origin_rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%origin_vh_varid, self%info(j)%origin_vh(:), start=[1,idslot], count=[NDIM,1]), "netcdf_io_write_info_body nf90_put_var origin_vh_varid" ) + + call netcdf_io_check( nf90_put_var(nc%id, nc%collision_id_varid, self%info(j)%collision_id, start=[idslot]), "netcdf_io_write_info_body nf90_put_var collision_id_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%discard_time_varid, self%info(j)%discard_time, start=[idslot]), "netcdf_io_write_info_body nf90_put_var discard_time_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%discard_rh_varid, self%info(j)%discard_rh(:), start=[1,idslot], count=[NDIM,1]), "netcdf_io_write_info_body nf90_put_var discard_rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%discard_vh_varid, self%info(j)%discard_vh(:), start=[1,idslot], count=[NDIM,1]), "netcdf_io_write_info_body nf90_put_var discard_vh_varid" ) + end if + + end do + end associate + end select + + call netcdf_io_check( nf90_set_fill(nc%id, old_mode, old_mode) ) + return + end subroutine swiftest_io_netcdf_write_info_body + + + module subroutine swiftest_io_netcdf_write_info_cb(self, nc, param) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Write the central body info to file + 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 + ! Internals + integer(I4B) :: idslot, old_mode + character(len=:), allocatable :: charstring + + ! This string of spaces of length NAMELEN is used to clear out any old data left behind inside the string variables + call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "netcdf_io_write_info_cb nf90_set_fill nf90_nofill" ) + + idslot = self%id + 1 + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, self%id, start=[idslot]), "netcdf_io_write_info_cb nf90_put_var id_varid" ) + + charstring = trim(adjustl(self%info%name)) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_io_write_info_cb nf90_put_var name_varid" ) + + charstring = trim(adjustl(self%info%particle_type)) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_io_write_info_cb nf90_put_var ptype_varid" ) + + if (param%lclose) then + charstring = trim(adjustl(self%info%origin_type)) + call netcdf_io_check( nf90_put_var(nc%id, nc%origin_type_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_io_write_info_body nf90_put_var cb origin_type_varid" ) + + call netcdf_io_check( nf90_put_var(nc%id, nc%origin_time_varid, self%info%origin_time, start=[idslot]), "netcdf_io_write_info_body nf90_put_var cb origin_time_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%origin_rh_varid, self%info%origin_rh(:), start=[1, idslot], count=[NDIM,1]), "netcdf_io_write_info_body nf90_put_var cb origin_rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%origin_vh_varid, self%info%origin_vh(:), start=[1, idslot], count=[NDIM,1]), "netcdf_io_write_info_body nf90_put_var cb origin_vh_varid" ) + + call netcdf_io_check( nf90_put_var(nc%id, nc%collision_id_varid, self%info%collision_id, start=[idslot]), "netcdf_io_write_info_body nf90_put_var cb collision_id_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%discard_time_varid, self%info%discard_time, start=[idslot]), "netcdf_io_write_info_body nf90_put_var cb discard_time_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%discard_rh_varid, self%info%discard_rh(:), start=[1, idslot], count=[NDIM,1]), "netcdf_io_write_info_body nf90_put_var cb discard_rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%discard_vh_varid, self%info%discard_vh(:), start=[1, idslot], count=[NDIM,1]), "netcdf_io_write_info_body nf90_put_var cb discard_vh_varid" ) + end if + call netcdf_io_check( nf90_set_fill(nc%id, old_mode, old_mode) ) + + return + end subroutine swiftest_io_netcdf_write_info_cb + + + module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, iomsg) + !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Read in parameters for the integration + !! Currently this procedure does not work in user-defined derived-type input mode + !! e.g. read(unit,'(DT)') param + !! as the newline characters are ignored in the input file when compiled in ifort. + !! + !! Adapted from David E. Kaufmann's Swifter routine io_init_param.f90 + !! Adapted from Martin Duncan's Swift routine io_init_param.f + implicit none + ! Arguments + class(swiftest_parameters), intent(inout) :: self !! Collection of parameters + integer, 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, intent(out) :: iostat !! IO status code + character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 + ! Internals + logical :: tstart_set = .false. !! Is the final time set in the input file? + logical :: tstop_set = .false. !! Is the final time set in the input file? + logical :: dt_set = .false. !! Is the step size set in the input file? + integer(I4B) :: ilength, ifirst, ilast, i !! Variables used to parse input file + character(STRMAX) :: line !! Line of the input file + character(len=:), allocatable :: line_trim,param_name, param_value !! Strings used to parse the param file + character(*),parameter :: linefmt = '(A)' !! Format code for simple text string + integer(I4B) :: nseeds, nseeds_from_file + logical :: seed_set = .false. !! Is the random seed set in the input file? + character(len=:), allocatable :: integrator + + + ! Parse the file line by line, extracting tokens then matching them up with known parameters if possible + associate(param => self) + call random_seed(size = nseeds) + if (allocated(param%seed)) deallocate(param%seed) + allocate(param%seed(nseeds)) + open(unit = unit, file = param%param_file_name, status = 'old', err = 667, iomsg = iomsg) + do + read(unit = unit, fmt = linefmt, end = 1, err = 667, iomsg = iomsg) line + line_trim = trim(adjustl(line)) + ilength = len(line_trim) + if ((ilength /= 0)) then + ifirst = 1 + ! Read the pair of tokens. The first one is the parameter name, the second is the value. + param_name = swiftest_io_get_token(line_trim, ifirst, ilast, iostat) + if (param_name == '') cycle ! No parameter name (usually because this line is commented out) + call swiftest_io_toupper(param_name) + ifirst = ilast + 1 + param_value = swiftest_io_get_token(line_trim, ifirst, ilast, iostat) + select case (param_name) + case ("T0") + read(param_value, *, err = 667, iomsg = iomsg) param%t0 + case ("TSTART") + read(param_value, *, err = 667, iomsg = iomsg) param%tstart + tstart_set = .true. + case ("TSTOP") + read(param_value, *, err = 667, iomsg = iomsg) param%tstop + tstop_set = .true. + case ("DT") + read(param_value, *, err = 667, iomsg = iomsg) param%dt + dt_set = .true. + case ("CB_IN") + param%incbfile = param_value + case ("PL_IN") + param%inplfile = param_value + case ("TP_IN") + param%intpfile = param_value + case ("NC_IN") + param%in_netcdf = param_value + case ("IN_TYPE") + call swiftest_io_toupper(param_value) + param%in_type = param_value + case ("IN_FORM") + call swiftest_io_toupper(param_value) + param%in_form = param_value + case ("ISTEP_OUT") + read(param_value, *) param%istep_out + case ("BIN_OUT") + param%outfile = param_value + case ("OUT_TYPE") + call swiftest_io_toupper(param_value) + param%out_type = param_value + case ("OUT_FORM") + call swiftest_io_toupper(param_value) + param%out_form = param_value + case ("OUT_STAT") + call swiftest_io_toupper(param_value) + param%out_stat = param_value + case ("DUMP_CADENCE") + read(param_value, *, err = 667, iomsg = iomsg) param%dump_cadence + case ("CHK_CLOSE") + call swiftest_io_toupper(param_value) + if (param_value == "YES" .or. param_value == 'T') param%lclose = .true. + case ("CHK_RMIN") + read(param_value, *, err = 667, iomsg = iomsg) param%rmin + case ("CHK_RMAX") + read(param_value, *, err = 667, iomsg = iomsg) param%rmax + case ("CHK_EJECT") + read(param_value, *, err = 667, iomsg = iomsg) param%rmaxu + case ("CHK_QMIN") + read(param_value, *, err = 667, iomsg = iomsg) param%qmin + case ("CHK_QMIN_COORD") + call swiftest_io_toupper(param_value) + param%qmin_coord = param_value + case ("CHK_QMIN_RANGE") + read(param_value, *, err = 667, iomsg = iomsg) param%qmin_alo + ifirst = ilast + 1 + param_value = swiftest_io_get_token(line, ifirst, ilast, iostat) + read(param_value, *, err = 667, iomsg = iomsg) param%qmin_ahi + case ("EXTRA_FORCE") + call swiftest_io_toupper(param_value) + if (param_value == "YES" .or. param_value == 'T') param%lextra_force = .true. + case ("BIG_DISCARD") + call swiftest_io_toupper(param_value) + if (param_value == "YES" .or. param_value == 'T' ) param%lbig_discard = .true. + case ("RHILL_PRESENT") + call swiftest_io_toupper(param_value) + if (param_value == "YES" .or. param_value == 'T' ) param%lrhill_present = .true. + case ("MU2KG") + read(param_value, *, err = 667, iomsg = iomsg) param%MU2KG + case ("TU2S") + read(param_value, *, err = 667, iomsg = iomsg) param%TU2S + case ("DU2M") + read(param_value, *, err = 667, iomsg = iomsg) param%DU2M + case ("ENERGY") + call swiftest_io_toupper(param_value) + if (param_value == "YES" .or. param_value == 'T') param%lenergy = .true. + case ("GR") + call swiftest_io_toupper(param_value) + if (param_value == "YES" .or. param_value == 'T') param%lgr = .true. + case ("ROTATION") + call swiftest_io_toupper(param_value) + if (param_value == "YES" .or. param_value == 'T') param%lrotation = .true. + case ("TIDES") + call swiftest_io_toupper(param_value) + if (param_value == "YES" .or. param_value == 'T') param%ltides = .true. + case ("INTERACTION_LOOPS") + call swiftest_io_toupper(param_value) + param%interaction_loops = param_value + case ("ENCOUNTER_CHECK_PLPL") + call swiftest_io_toupper(param_value) + param%encounter_check_plpl = param_value + case ("ENCOUNTER_CHECK_PLTP") + call swiftest_io_toupper(param_value) + param%encounter_check_pltp = param_value + case ("ENCOUNTER_CHECK") + call swiftest_io_toupper(param_value) + param%encounter_check_plpl = param_value + param%encounter_check_pltp = param_value + case ("FIRSTKICK") + call swiftest_io_toupper(param_value) + if (param_value == "NO" .or. param_value == 'F') param%lfirstkick = .false. + case ("FIRSTENERGY") + call swiftest_io_toupper(param_value) + if (param_value == "NO" .or. param_value == 'F') param%lfirstenergy = .false. + case("EORBIT_ORIG") + read(param_value, *, err = 667, iomsg = iomsg) param%Eorbit_orig + case("GMTOT_ORIG") + read(param_value, *, err = 667, iomsg = iomsg) param%GMtot_orig + case("LTOT_ORIG") + read(param_value, *, err = 667, iomsg = iomsg) param%Ltot_orig(1) + do i = 2, NDIM + ifirst = ilast + 2 + param_value = swiftest_io_get_token(line, ifirst, ilast, iostat) + read(param_value, *, err = 667, iomsg = iomsg) param%Ltot_orig(i) + end do + case("LORBIT_ORIG") + read(param_value, *, err = 667, iomsg = iomsg) param%Lorbit_orig(1) + do i = 2, NDIM + ifirst = ilast + 2 + param_value = swiftest_io_get_token(line, ifirst, ilast, iostat) + read(param_value, *, err = 667, iomsg = iomsg) param%Lorbit_orig(i) + end do + case("LSPIN_ORIG") + read(param_value, *, err = 667, iomsg = iomsg) param%Lspin_orig(1) + do i = 2, NDIM + ifirst = ilast + 2 + param_value = swiftest_io_get_token(line, ifirst, ilast, iostat) + read(param_value, *, err = 667, iomsg = iomsg) param%Lspin_orig(i) + end do + case("LESCAPE") + read(param_value, *, err = 667, iomsg = iomsg) param%Lescape(1) + do i = 2, NDIM + ifirst = ilast + 2 + param_value = swiftest_io_get_token(line, ifirst, ilast, iostat) + read(param_value, *, err = 667, iomsg = iomsg) param%Lescape(i) + end do + case("GMESCAPE") + read(param_value, *, err = 667, iomsg = iomsg) param%GMescape + case("ECOLLISIONS") + read(param_value, *, err = 667, iomsg = iomsg) param%Ecollisions + case("EUNTRACKED") + read(param_value, *, err = 667, iomsg = iomsg) param%Euntracked + case ("MAXID") + read(param_value, *, err = 667, iomsg = iomsg) param%maxid + case ("MAXID_COLLISION") + read(param_value, *, err = 667, iomsg = iomsg) param%maxid_collision + case ("COLLISION_MODEL") + call swiftest_io_toupper(param_value) + read(param_value, *) param%collision_model + case ("GMTINY") + read(param_value, *) param%GMTINY + case ("MIN_GMFRAG") + read(param_value, *) param%min_GMfrag + case ("ENCOUNTER_SAVE") + call swiftest_io_toupper(param_value) + read(param_value, *) param%encounter_save + case("SEED") + read(param_value, *) nseeds_from_file + ! Because the number of seeds can vary between compilers/systems, we need to make sure we can handle cases in which the input file has a different + ! number of seeds than the current nbody_system. If the number of seeds in the file is smaller than required, we will use them as a source to fill in the missing elements. + ! If the number of seeds in the file is larger than required, we will truncate the seed array. + if (nseeds_from_file > nseeds) then + nseeds = nseeds_from_file + deallocate(param%seed) + allocate(param%seed(nseeds)) + do i = 1, nseeds + ifirst = ilast + 2 + param_value = swiftest_io_get_token(line, ifirst, ilast, iostat) + read(param_value, *) param%seed(i) + end do + else ! Seed array in file is too small + do i = 1, nseeds_from_file + ifirst = ilast + 2 + param_value = swiftest_io_get_token(line, ifirst, ilast, iostat) + read(param_value, *) param%seed(i) + end do + param%seed(nseeds_from_file+1:nseeds) = [(param%seed(1) - param%seed(nseeds_from_file) + i, & + i=nseeds_from_file+1, nseeds)] + end if + seed_set = .true. + case ("RESTART") + if (param_value == "NO" .or. param_value == 'F') then + param%lrestart = .false. + else if (param_value == "YES" .or. param_value == 'T') then + param%lrestart = .true. + end if + ! Ignore SyMBA-specific, not-yet-implemented, or obsolete input parameters + case ("NPLMAX", "NTPMAX", "YARKOVSKY", "YORP") + case default + write(*,*) "Ignoring unknown parameter -> ",param_name + end select + end if + end do + 1 continue + close(unit) + iostat = 0 + + ! Do basic sanity checks on the input values + if ((.not. tstart_set) .or. (.not. tstop_set) .or. (.not. dt_set)) then + write(iomsg,*) 'Valid simulation time not set' + iostat = -1 + return + end if + if (param%dt <= 0.0_DP) then + write(iomsg,*) 'Invalid timestep: ' + iostat = -1 + return + end if + if (param%inplfile == "") then + write(iomsg,*) 'No valid massive body file in input file' + iostat = -1 + return + end if + if ((param%in_type /= "ASCII") .and. (param%in_type /= "NETCDF_FLOAT") .and. (param%in_type /= "NETCDF_DOUBLE")) then + write(iomsg,*) 'Invalid input file type:',trim(adjustl(param%in_type)) + iostat = -1 + return + end if + if (param%istep_out <= 0) then + write(iomsg,*) 'Invalid ISTEP_OUT. Must be a positive integer' + iostat = -1 + return + end if + if (param%dump_cadence < 0) then + write(iomsg,*) 'Invalid DUMP_CADENCE. Must be a positive integer or 0.' + iostat = -1 + return + end if + if ((param%istep_out > 0) .and. (param%outfile == "")) then + write(iomsg,*) 'Invalid outfile' + iostat = -1 + return + end if + param%lrestart = (param%out_stat == "APPEND") + if (param%outfile /= "") then + if ((param%out_type /= "NETCDF_FLOAT") .and. (param%out_type /= "NETCDF_DOUBLE")) then + write(iomsg,*) 'Invalid out_type: ',trim(adjustl(param%out_type)) + iostat = -1 + return + end if + if ((param%out_form /= "EL") .and. (param%out_form /= "XV") .and. (param%out_form /= "XVEL")) then + write(iomsg,*) 'Invalid out_form: ',trim(adjustl(param%out_form)) + iostat = -1 + return + end if + if ((param%out_stat /= "NEW") .and. (param%out_stat /= "REPLACE") .and. (param%out_stat /= "APPEND") & + .and. (param%out_stat /= "UNKNOWN")) then + write(iomsg,*) 'Invalid out_stat: ',trim(adjustl(param%out_stat)) + iostat = -1 + return + end if + end if + if (param%qmin > 0.0_DP) then + if ((param%qmin_coord /= "HELIO") .and. (param%qmin_coord /= "BARY")) then + write(iomsg,*) 'Invalid qmin_coord: ',trim(adjustl(param%qmin_coord)) + iostat = -1 + return + end if + if ((param%qmin_alo <= 0.0_DP) .or. (param%qmin_ahi <= 0.0_DP)) then + write(iomsg,*) 'Invalid qmin vals' + iostat = -1 + return + end if + end if + if (param%ltides .and. .not. param%lrotation) then + write(iomsg,*) 'Tides require rotation to be turned on' + iostat = -1 + return + end if + + if ((param%MU2KG < 0.0_DP) .or. (param%TU2S < 0.0_DP) .or. (param%DU2M < 0.0_DP)) then + write(iomsg,*) 'Invalid unit conversion factor' + iostat = -1 + return + end if + + ! Calculate the G for the nbody_system units + param%GU = GC / (param%DU2M**3 / (param%MU2KG * param%TU2S**2)) + + + ! A minimal log of collision outcomes is stored in the following log file + ! More complete data on collisions is stored in the NetCDF output files + call swiftest_io_log_start(param, COLLISION_LOG_OUT, "Collision logfile") + + if ((param%encounter_save /= "NONE") .and. & + (param%encounter_save /= "TRAJECTORY") .and. & + (param%encounter_save /= "CLOSEST") .and. & + (param%encounter_save /= "BOTH")) then + write(iomsg,*) 'Invalid encounter_save parameter: ',trim(adjustl(param%out_type)) + write(iomsg,*) 'Valid options are NONE, TRAJECTORY, CLOSEST, or BOTH' + iostat = -1 + return + end if + + param%lenc_save_trajectory = (param%encounter_save == "TRAJECTORY") .or. (param%encounter_save == "BOTH") + param%lenc_save_closest = (param%encounter_save == "CLOSEST") .or. (param%encounter_save == "BOTH") + + integrator = v_list(1) + if ((integrator == INT_RMVS) .or. (integrator == INT_SYMBA)) then + if (.not.param%lclose) then + write(iomsg,*) 'This integrator requires CHK_CLOSE to be enabled.' + iostat = -1 + return + end if + end if + + param%lmtiny_pl = (integrator == INT_SYMBA) + + if (param%lmtiny_pl .and. param%GMTINY < 0.0_DP) then + write(iomsg,*) "GMTINY invalid or not set: ", param%GMTINY + iostat = -1 + return + end if + + if ((param%collision_model /= "MERGE") .and. & + (param%collision_model /= "BOUNCE") .and. & + (param%collision_model /= "FRAGGLE")) then + write(iomsg,*) 'Invalid collision_model parameter: ',trim(adjustl(param%out_type)) + write(iomsg,*) 'Valid options are MERGE, BOUNCE, or FRAGGLE' + iostat = -1 + return + end if + + if (param%collision_model == "FRAGGLE" ) then + if (seed_set) then + call random_seed(put = param%seed) + else + call random_seed(get = param%seed) + end if + if (param%min_GMfrag < 0.0_DP) param%min_GMfrag = param%GMTINY + end if + + ! Determine if the GR flag is set correctly for this integrator + select case(integrator) + case(INT_WHM, INT_RMVS, INT_HELIO, INT_SYMBA) + case default + if (param%lgr) write(iomsg, *) 'GR is not yet implemented for this integrator. This parameter will be ignored.' + param%lgr = .false. + end select + + if (param%lgr) then + ! Calculate the inverse speed of light in the nbody_system units + param%inv_c2 = einsteinC * param%TU2S / param%DU2M + param%inv_c2 = (param%inv_c2)**(-2) + end if + + select case(trim(adjustl(param%interaction_loops))) + case("ADAPTIVE") + param%ladaptive_interactions = .true. + param%lflatten_interactions = .true. + call swiftest_io_log_start(param, INTERACTION_TIMER_LOG_OUT, "Interaction loop timer logfile") + call swiftest_io_log_one_message(INTERACTION_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, nplpl, metric") + case("TRIANGULAR") + param%ladaptive_interactions = .false. + param%lflatten_interactions = .false. + case("FLAT") + param%ladaptive_interactions = .false. + param%lflatten_interactions = .true. + case default + write(*,*) "Unknown value for parameter INTERACTION_LOOPS: -> ",trim(adjustl(param%interaction_loops)) + write(*,*) "Must be one of the following: TRIANGULAR, FLAT, or ADAPTIVE" + write(*,*) "Using default value of ADAPTIVE" + param%interaction_loops = "ADAPTIVE" + param%ladaptive_interactions = .true. + param%lflatten_interactions = .true. + call swiftest_io_log_start(param, INTERACTION_TIMER_LOG_OUT, "Interaction loop timer logfile") + call swiftest_io_log_one_message(INTERACTION_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, nplpl, metric") + end select + + select case(trim(adjustl(param%encounter_check_plpl))) + case("ADAPTIVE") + param%ladaptive_encounters_plpl = .true. + param%lencounter_sas_plpl = .true. + call swiftest_io_log_start(param, ENCOUNTER_PLPL_TIMER_LOG_OUT, "Encounter check loop timer logfile") + call swiftest_io_log_one_message(ENCOUNTER_PLPL_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, nplpl, metric") + case("TRIANGULAR") + param%ladaptive_encounters_plpl = .false. + param%lencounter_sas_plpl = .false. + case("SORTSWEEP") + param%ladaptive_encounters_plpl = .false. + param%lencounter_sas_plpl = .true. + case default + write(*,*) "Unknown value for parameter ENCOUNTER_CHECK_PLPL: -> ",trim(adjustl(param%encounter_check_plpl)) + write(*,*) "Must be one of the following: TRIANGULAR, SORTSWEEP, or ADAPTIVE" + write(*,*) "Using default value of ADAPTIVE" + param%encounter_check_plpl = "ADAPTIVE" + param%ladaptive_encounters_plpl = .true. + param%lencounter_sas_plpl = .true. + call swiftest_io_log_start(param, ENCOUNTER_PLPL_TIMER_LOG_OUT, "Encounter check loop timer logfile") + call swiftest_io_log_one_message(ENCOUNTER_PLPL_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, nplpl, metric") + end select + + select case(trim(adjustl(param%encounter_check_pltp))) + case("ADAPTIVE") + param%ladaptive_encounters_pltp = .true. + param%lencounter_sas_pltp = .true. + call swiftest_io_log_start(param, ENCOUNTER_PLTP_TIMER_LOG_OUT, "Encounter check loop timer logfile") + call swiftest_io_log_one_message(ENCOUNTER_PLTP_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, npltp, metric") + case("TRIANGULAR") + param%ladaptive_encounters_pltp = .false. + param%lencounter_sas_pltp = .false. + case("SORTSWEEP") + param%ladaptive_encounters_pltp = .false. + param%lencounter_sas_pltp = .true. + case default + write(*,*) "Unknown value for parameter ENCOUNTER_CHECK_PLTP: -> ",trim(adjustl(param%encounter_check_pltp)) + write(*,*) "Must be one of the following: TRIANGULAR, SORTSWEEP, or ADAPTIVE" + write(*,*) "Using default value of ADAPTIVE" + param%encounter_check_pltp = "ADAPTIVE" + param%ladaptive_encounters_pltp = .true. + param%lencounter_sas_pltp = .true. + call swiftest_io_log_start(param, ENCOUNTER_PLTP_TIMER_LOG_OUT, "Encounter check loop timer logfile") + call swiftest_io_log_one_message(ENCOUNTER_PLTP_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, npltp, metric") + end select + + iostat = 0 + + ! Print the contents of the parameter file to standard output + call param%writer(unit = param%display_unit, iotype = "none", v_list = [0], iostat = iostat, iomsg = iomsg) + + end associate + + return + 667 continue + write(*,*) "Error reading param file: ", trim(adjustl(iomsg)) + end subroutine swiftest_io_param_reader + + + module subroutine swiftest_io_param_writer(self, unit, iotype, v_list, iostat, iomsg) + !! author: David A. Minton + !! + !! Dump integration parameters to file + !! + !! Adapted from David E. Kaufmann's Swifter routine io_dump_param.f90 + !! Adapted from Martin Duncan's Swift routine io_dump_param.f + implicit none + ! Arguments + class(swiftest_parameters),intent(in) :: self !! Collection of parameters + integer, 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, intent(in) :: v_list(:) !! Not used in this procedure + integer, intent(out) :: iostat !! IO status code + character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 + ! Internals + character(*),parameter :: Ifmt = '(I0)' !! Format label for integer values + character(*),parameter :: Rfmt = '(ES25.17)' !! Format label for real values + character(*),parameter :: Lfmt = '(L1)' !! Format label for logical values + integer(I4B) :: nseeds + + associate(param => self) + call io_param_writer_one("T0", param%t0, unit) + call io_param_writer_one("TSTART", param%tstart, unit) + call io_param_writer_one("TSTOP", param%tstop, unit) + call io_param_writer_one("DT", param%dt, unit) + call io_param_writer_one("IN_TYPE", param%in_type, unit) + if (param%in_type == "ASCII") then + call io_param_writer_one("CB_IN", param%incbfile, unit) + call io_param_writer_one("PL_IN", param%inplfile, unit) + call io_param_writer_one("TP_IN", param%intpfile, unit) + else + call io_param_writer_one("NC_IN", param%in_netcdf, unit) + end if + + call io_param_writer_one("IN_FORM", param%in_form, unit) + if (param%dump_cadence > 0) call io_param_writer_one("DUMP_CADENCE",param%dump_cadence, unit) + if (param%istep_out > 0) then + call io_param_writer_one("ISTEP_OUT", param%istep_out, unit) + call io_param_writer_one("BIN_OUT", param%outfile, unit) + call io_param_writer_one("OUT_TYPE", param%out_type, unit) + call io_param_writer_one("OUT_FORM", param%out_form, unit) + call io_param_writer_one("OUT_STAT", "APPEND", unit) + end if + call io_param_writer_one("CHK_RMIN", param%rmin, unit) + call io_param_writer_one("CHK_RMAX", param%rmax, unit) + call io_param_writer_one("CHK_EJECT", param%rmaxu, unit) + call io_param_writer_one("CHK_QMIN", param%qmin, unit) + if (param%qmin >= 0.0_DP) then + call io_param_writer_one("CHK_QMIN_COORD", param%qmin_coord, unit) + call io_param_writer_one("CHK_QMIN_RANGE", [param%qmin_alo, param%qmin_ahi], unit) + end if + call io_param_writer_one("MU2KG", param%MU2KG, unit) + call io_param_writer_one("TU2S", param%TU2S , unit) + call io_param_writer_one("DU2M", param%DU2M, unit) + call io_param_writer_one("RHILL_PRESENT", param%lrhill_present, unit) + call io_param_writer_one("EXTRA_FORCE", param%lextra_force, unit) + call io_param_writer_one("CHK_CLOSE", param%lclose, unit) + call io_param_writer_one("ENERGY", param%lenergy, unit) + call io_param_writer_one("GR", param%lgr, unit) + call io_param_writer_one("ROTATION", param%lrotation, unit) + call io_param_writer_one("TIDES", param%ltides, unit) + call io_param_writer_one("INTERACTION_LOOPS", param%interaction_loops, unit) + call io_param_writer_one("ENCOUNTER_CHECK_PLPL", param%encounter_check_plpl, unit) + call io_param_writer_one("ENCOUNTER_CHECK_PLTP", param%encounter_check_pltp, unit) + call io_param_writer_one("ENCOUNTER_SAVE", param%encounter_save, unit) + + if (param%lenergy) then + call io_param_writer_one("FIRSTENERGY", param%lfirstenergy, unit) + end if + call io_param_writer_one("FIRSTKICK",param%lfirstkick, unit) + call io_param_writer_one("MAXID",param%maxid, unit) + call io_param_writer_one("MAXID_COLLISION",param%maxid_collision, unit) + + if (param%GMTINY > 0.0_DP) call io_param_writer_one("GMTINY",param%GMTINY, unit) + if (param%min_GMfrag > 0.0_DP) call io_param_writer_one("MIN_GMFRAG",param%min_GMfrag, unit) + call io_param_writer_one("COLLISION_MODEL",param%collision_model, unit) + if (param%collision_model == "FRAGGLE" ) then + nseeds = size(param%seed) + call io_param_writer_one("SEED", [nseeds, param%seed(:)], unit) + end if + + iostat = 0 + iomsg = "UDIO not implemented" + end associate + + 667 continue + return + end subroutine swiftest_io_param_writer + + + module subroutine swiftest_io_param_writer_one_char(param_name, param_value, unit) + !! author: David A. Minton + !! + !! Writes a single parameter name/value pair to a file unit. + !! This version is for character param_value type + implicit none + ! Arguments + 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 + ! Internals + character(len=NAMELEN) :: param_name_fixed_width !! Parameter label converted to fixed-width string + character(len=STRMAX) :: iomsg !! Message to pass if iostat /= 0 + + write(param_name_fixed_width, *) param_name + write(unit, *, err = 667, iomsg = iomsg) adjustl(param_name_fixed_width) // " " // trim(adjustl(param_value)) + + return + 667 continue + write(*,*) 'Error writing parameter: ',trim(adjustl(iomsg)) + end subroutine swiftest_io_param_writer_one_char + + + module subroutine swiftest_io_param_writer_one_DP(param_name, param_value, unit) + !! author: David A. Minton + !! + !! Writes a single parameter name/value pair to a file unit. + !! This version is for real(DP) param_value type + implicit none + ! Arguments + 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 + ! Internals + character(len=STRMAX) :: param_value_string !! Parameter value converted to a string + character(*),parameter :: Rfmt = '(ES25.17)' !! Format label for real values + + write(param_value_string,Rfmt) param_value + call io_param_writer_one(param_name, param_value_string, unit) + + return + end subroutine swiftest_io_param_writer_one_DP + + + module subroutine swiftest_io_param_writer_one_DParr(param_name, param_value, unit) + !! author: David A. Minton + !! + !! Writes a single parameter name/value pair to a file unit. + !! This version is for real(DP) arrays () param_value type + implicit none + ! Arguments + 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 + ! Internals + character(len=STRMAX) :: param_value_string !! Parameter value converted to a string + character(*),parameter :: Rfmt = '(ES25.17)' !! Format label for real values + character(len=25) :: arr_val + integer(I4B) :: i, narr + + narr = size(param_value) + do i = 1, narr + write(arr_val, Rfmt) param_value(i) + if (i == 1) then + write(param_value_string, *) arr_val + else + param_value_string = trim(adjustl(param_value_string)) // " " // arr_val + end if + end do + + call io_param_writer_one(param_name, param_value_string, unit) + + return + end subroutine swiftest_io_param_writer_one_DParr + + + module subroutine swiftest_io_param_writer_one_I4B(param_name, param_value, unit) + !! author: David A. Minton + !! + !! Writes a single parameter name/value pair to a file unit. + !! This version is for integer(I4B) param_value type + implicit none + ! Arguments + 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 + ! Internals + character(len=STRMAX) :: param_value_string !! Parameter value converted to a string + character(*),parameter :: Ifmt = '(I0)' !! Format label for integer values + + write(param_value_string,Ifmt) param_value + call io_param_writer_one(param_name, param_value_string, unit) + + return + end subroutine swiftest_io_param_writer_one_I4B + + + module subroutine swiftest_io_param_writer_one_I8B(param_name, param_value, unit) + !! author: David A. Minton + !! + !! Writes a single parameter name/value pair to a file unit. + !! This version is for integer(I8B) param_value type + implicit none + ! Arguments + 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 + ! Internals + character(len=STRMAX) :: param_value_string !! Parameter value converted to a string + character(*),parameter :: Ifmt = '(I0)' !! Format label for integer values + + write(param_value_string,Ifmt) param_value + call io_param_writer_one(param_name, param_value_string, unit) + + return + end subroutine swiftest_io_param_writer_one_I8B + + + module subroutine swiftest_io_param_writer_one_I4Barr(param_name, param_value, unit) + !! author: David A. Minton + !! + !! Writes a single parameter name/value pair to a file unit. + !! This version is for integer(I4B) arrays param_value type + implicit none + ! Arguments + 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 + ! Internals + character(len=STRMAX) :: param_value_string !! Parameter value converted to a string + character(*),parameter :: Ifmt = '(I0)' !! Format label for integer values + character(len=25) :: arr_val + integer(I4B) :: i, narr + + narr = size(param_value) + do i = 1, narr + write(arr_val, Ifmt) param_value(i) + if (i == 1) then + write(param_value_string, *) trim(adjustl(arr_val)) + else + param_value_string = trim(adjustl(param_value_string)) // " " // trim(adjustl(arr_val)) + end if + end do + + call io_param_writer_one(param_name, param_value_string, unit) + + return + end subroutine swiftest_io_param_writer_one_I4Barr + + + module subroutine swiftest_io_param_writer_one_logical(param_name, param_value, unit) + !! author: David A. Minton + !! + !! Writes a single parameter name/value pair to a file unit. + !! This version is for logical param_value type + implicit none + ! Arguments + 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 + ! Internals + character(len=STRMAX) :: param_value_string !! Parameter value converted to a string + character(*),parameter :: Lfmt = '(L1)' !! Format label for logical values + + write(param_value_string,Lfmt) param_value + call io_param_writer_one(param_name, param_value_string, unit) + + return + end subroutine swiftest_io_param_writer_one_logical + + + module subroutine swiftest_io_param_writer_one_QP(param_name, param_value, unit) + !! author: David A. Minton + !! + !! Writes a single parameter name/value pair to a file unit. + !! This version is for real(QP) param_value type + implicit none + ! Arguments + 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 + ! Internals + character(len=STRMAX) :: param_value_string !! Parameter value converted to a string + character(*),parameter :: Rfmt = '(ES25.17)' !! Format label for real values + + write(param_value_string,Rfmt) param_value + call io_param_writer_one(param_name, param_value_string, unit) + + return + end subroutine swiftest_io_param_writer_one_QP + + + module subroutine swiftest_io_read_in_body(self, param) + !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Read in either test particle or massive body data + !! + !! Adapted from David E. Kaufmann's Swifter routine swiftest_init_pl.f90 and swiftest_init_tp.f90 + !! Adapted from Martin Duncan's Swift routine swiftest_init_pl.f and swiftest_init_tp.f + implicit none + ! Arguments + class(swiftest_body), intent(inout) :: self !! Swiftest particle object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: iu = LUN + integer(I4B) :: i, nbody + character(len=:), allocatable :: infile + character(STRMAX) :: errmsg + ! Internals + integer(I4B) :: ierr !! Error code: returns 0 if the read is successful + + ! Select the appropriate polymorphic class (test particle or massive body) + if (param%in_type /= "ASCII") return ! Not for NetCDF + + select type(self) + class is (swiftest_pl) + infile = param%inplfile + class is (swiftest_tp) + infile = param%intpfile + end select + + open(unit = iu, file = infile, status = 'old', form = 'FORMATTED', err = 667, iomsg = errmsg) + read(iu, *, err = 667, iomsg = errmsg) nbody + + call self%setup(nbody, param) + ierr = 0 + if (nbody > 0) then + ierr = self%read_frame(iu, param) + self%status(:) = ACTIVE + self%lmask(:) = .true. + do i = 1, nbody + call self%info(i)%set_value(status="ACTIVE") + end do + end if + close(iu, err = 667, iomsg = errmsg) + + if (ierr == 0) return + + 667 continue + write(*,*) 'Error reading in initial conditions file: ',trim(adjustl(errmsg)) + return + end subroutine swiftest_io_read_in_body + + + module subroutine swiftest_io_read_in_cb(self, param) + !! author: David A. Minton + !! + !! Reads in central body data + !! + !! Adapted from David E. Kaufmann's Swifter routine swiftest_init_pl.f90 + !! Adapted from Martin Duncan's Swift routine swiftest_init_pl.f + implicit none + ! Arguments + class(swiftest_cb), intent(inout) :: self + class(swiftest_parameters), intent(inout) :: param + ! Internals + integer(I4B) :: iu = LUN + character(len=STRMAX) :: errmsg + integer(I4B) :: ierr + character(len=NAMELEN) :: name + + if (param%in_type /= "ASCII") return ! Not for NetCDF + + self%id = 0 + param%maxid = 0 + open(unit = iu, file = param%incbfile, status = 'old', form = 'FORMATTED', err = 667, iomsg = errmsg) + read(iu, *, err = 667, iomsg = errmsg) name + call self%info%set_value(name=name) + read(iu, *, err = 667, iomsg = errmsg) self%Gmass + self%mass = real(self%Gmass / param%GU, kind=DP) + read(iu, *, err = 667, iomsg = errmsg) self%radius + read(iu, *, err = 667, iomsg = errmsg) self%j2rp2 + read(iu, *, err = 667, iomsg = errmsg) self%j4rp4 + if (param%lrotation) then + read(iu, *, err = 667, iomsg = errmsg) self%Ip(1), self%Ip(2), self%Ip(3) + read(iu, *, err = 667, iomsg = errmsg) self%rot(1), self%rot(2), self%rot(3) + end if + ierr = 0 + close(iu, err = 667, iomsg = errmsg) + + if (ierr == 0) then + + if (param%rmin < 0.0) param%rmin = self%radius + + self%GM0 = self%Gmass + self%dGM = 0.0_DP + self%R0 = self%radius + if (param%lrotation) then + self%L0(:) = self%Ip(3) * self%mass * self%radius**2 * self%rot(:) + self%dL(:) = 0.0_DP + end if + end if + return + + 667 continue + write(*,*) "Error reading central body file: " // trim(adjustl(errmsg)) + call util_exit(FAILURE) + end subroutine swiftest_io_read_in_cb + + + module subroutine swiftest_io_read_in_system(self, param) + !! author: David A. Minton and Carlisle A. Wishard + !! + !! Reads in the nbody_system from input files + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: self + class(swiftest_parameters), intent(inout) :: param + ! Internals + integer(I4B) :: ierr + class(swiftest_parameters), allocatable :: tmp_param + + if (param%in_type == "ASCII") then + call self%cb%read_in(param) + call self%pl%read_in(param) + call self%tp%read_in(param) + ! Copy over param file variable inputs + self%Eorbit_orig = param%Eorbit_orig + self%GMtot_orig = param%GMtot_orig + self%Ltot_orig(:) = param%Ltot_orig(:) + self%Lorbit_orig(:) = param%Lorbit_orig(:) + self%Lspin_orig(:) = param%Lspin_orig(:) + self%Lescape(:) = param%Lescape(:) + self%Ecollisions = param%Ecollisions + self%Euntracked = param%Euntracked + else + allocate(tmp_param, source=param) + tmp_param%system_history%nc%file_name = param%in_netcdf + tmp_param%out_form = param%in_form + if (.not. param%lrestart) then + ! Turn off energy computation so we don't have to feed it into the initial conditions + tmp_param%lenergy = .false. + end if + ierr = self%read_frame(tmp_param%system_history%nc, tmp_param) + deallocate(tmp_param) + if (ierr /=0) call util_exit(FAILURE) + end if + + param%loblatecb = ((self%cb%j2rp2 /= 0.0_DP) .or. (self%cb%j4rp4 /= 0.0_DP)) + if (.not.param%loblatecb) then + if (allocated(self%pl%aobl)) deallocate(self%pl%aobl) + if (allocated(self%tp%aobl)) deallocate(self%tp%aobl) + end if + + return + end subroutine swiftest_io_read_in_system + + + module function swiftest_io_read_frame_body(self, iu, param) result(ierr) + !! author: David A. Minton + !! + !! Reads a frame of output of either test particle or massive body data from a binary output file + !! + !! Adapted from David E. Kaufmann's Swifter routine io_read_frame.f90 + !! Adapted from Hal Levison's Swift routine io_read_frame.f + implicit none + ! Arguments + class(swiftest_body), intent(inout) :: self !! Swiftest particle 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 + ! Result + integer(I4B) :: ierr !! Error code: returns 0 if the read is successful + ! Internals + character(len=STRMAX) :: errmsg + character(len=NAMELEN), dimension(self%nbody) :: name + integer(I4B) :: i + real(QP) :: val + + if (self%nbody == 0) return + + if ((param%in_form /= "EL") .and. (param%in_form /= "XV")) then + write(errmsg, *) trim(adjustl(param%in_form)) // " is not a recognized format code for input files." + goto 667 + end if + + associate(n => self%nbody) + + if (param%in_form == "EL") then + if (.not.allocated(self%a)) allocate(self%a(n)) + if (.not.allocated(self%e)) allocate(self%e(n)) + if (.not.allocated(self%inc)) allocate(self%inc(n)) + if (.not.allocated(self%capom)) allocate(self%capom(n)) + if (.not.allocated(self%omega)) allocate(self%omega(n)) + if (.not.allocated(self%capm)) allocate(self%capm(n)) + end if + + select case(param%in_type) + case ("ASCII") + do i = 1, n + select type(self) + class is (swiftest_pl) + if (param%lrhill_present) then + read(iu, *, err = 667, iomsg = errmsg) name(i), val, self%rhill(i) + else + read(iu, *, err = 667, iomsg = errmsg) name(i), val + end if + self%Gmass(i) = real(val, kind=DP) + self%mass(i) = real(val / param%GU, kind=DP) + if (param%lclose) read(iu, *, err = 667, iomsg = errmsg) self%radius(i) + class is (swiftest_tp) + read(iu, *, err = 667, iomsg = errmsg) name(i) + end select + call self%info(i)%set_value(name=name(i)) + + select case(param%in_form) + case ("XV") + read(iu, *, err = 667, iomsg = errmsg) self%rh(1, i), self%rh(2, i), self%rh(3, i) + read(iu, *, err = 667, iomsg = errmsg) self%vh(1, i), self%vh(2, i), self%vh(3, i) + case ("EL") + read(iu, *, err = 667, iomsg = errmsg) self%a(i), self%e(i), self%inc(i) + read(iu, *, err = 667, iomsg = errmsg) self%capom(i), self%omega(i), self%capm(i) + end select + + select type (self) + class is (swiftest_pl) + if (param%lrotation) then + read(iu, *, err = 667, iomsg = errmsg) self%Ip(1, i), self%Ip(2, i), self%Ip(3, i) + read(iu, *, err = 667, iomsg = errmsg) self%rot(1, i), self%rot(2, i), self%rot(3, i) + end if + ! if (param%ltides) then + ! read(iu, *, err = 667, iomsg = errmsg) self%k2(i) + ! read(iu, *, err = 667, iomsg = errmsg) self%Q(i) + ! end if + end select + param%maxid = param%maxid + 1 + self%id(i) = param%maxid + end do + end select + + if (param%in_form == "EL") then + self%inc(1:n) = self%inc(1:n) * DEG2RAD + self%capom(1:n) = self%capom(1:n) * DEG2RAD + self%omega(1:n) = self%omega(1:n) * DEG2RAD + self%capm(1:n) = self%capm(1:n) * DEG2RAD + end if + end associate + + ierr = 0 + return + + 667 continue + select type (self) + class is (swiftest_pl) + write(*,*) "Error reading massive body file: " // trim(adjustl(errmsg)) + class is (swiftest_tp) + write(*,*) "Error reading test particle file: " // trim(adjustl(errmsg)) + class default + write(*,*) "Error reading body file: " // trim(adjustl(errmsg)) + end select + call util_exit(FAILURE) + end function swiftest_io_read_frame_body + + + module subroutine swiftest_io_read_in_param(self, param_file_name) + !! author: David A. Minton + !! + !! Read in parameters for the integration + !! + !! Adapted from David E. Kaufmann's Swifter routine io_init_param.f90 + !! Adapted from Martin Duncan's Swift routine io_init_param.f + implicit none + ! Arguments + 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) + ! Internals + integer(I4B) :: ierr = 0 !! Input error code + character(STRMAX) :: errmsg !! Error message in UDIO procedure + + ! Read in name of parameter file + self%param_file_name = trim(adjustl(param_file_name)) + write(self%display_unit, *) 'Parameter input file is ' // self%param_file_name + + !! todo: Currently this procedure does not work in user-defined derived-type input mode + !! as the newline characters are ignored in the input file when compiled in ifort. + + !read(LUN,'(DT)', iostat= ierr, iomsg = errmsg) self + call self%reader(LUN, iotype= "none", v_list = [self%integrator], iostat = ierr, iomsg = errmsg) + if (ierr == 0) return + + 667 continue + write(self%display_unit,*) "Error reading parameter file: " // trim(adjustl(errmsg)) + call util_exit(FAILURE) + end subroutine swiftest_io_read_in_param + + + module subroutine swiftest_io_set_display_param(self, display_style) + !! author: David A. Minton + !! + !! Sets the display style parameters. If display is "STANDARD" then output goes to stdout. If display is "COMPACT" + !! then it is redirected to a log file and a progress-bar is used for stdout + implicit none + ! Arguments + class(swiftest_parameters), intent(inout) :: self !! Current run configuration parameters + character(*), intent(in) :: display_style !! Style of the output display + ! Internals + character(STRMAX) :: errmsg + + select case(display_style) + case ('STANDARD') + self%display_unit = OUTPUT_UNIT !! stdout from iso_fortran_env + self%log_output = .false. + case ('COMPACT', 'PROGRESS') + open(unit=SWIFTEST_LOG_OUT, file=SWIFTEST_LOG_FILE, status='replace', err = 667, iomsg = errmsg) + self%display_unit = SWIFTEST_LOG_OUT + self%log_output = .true. + case default + write(*,*) display_style, " is an unknown display style" + call util_exit(USAGE) + end select + + self%display_style = display_style + + return + + 667 continue + write(*,*) "Error opening swiftest log file: " // trim(adjustl(errmsg)) + call util_exit(FAILURE) + end subroutine swiftest_io_set_display_param + + + module subroutine swiftest_io_toupper(string) + !! author: David A. Minton + !! + !! Convert string to uppercase + !! + !! Adapted from David E. Kaufmann's Swifter routine: util_toupper.f90 + implicit none + ! Arguments + character(*), intent(inout) :: string !! String to make upper case + ! Internals + integer(I4B) :: i, length, idx + + length = len(string) + do i = 1, length + idx = iachar(string(i:i)) + if ((idx >= lowercase_begin) .and. (idx <= lowercase_end)) then + idx = idx + uppercase_offset + string(i:i) = achar(idx) + end if + end do + + return + end subroutine swiftest_io_toupper + + + module subroutine swiftest_io_write_discard(self, param) + !! author: David A. Minton + !! + !! Write the metadata of the discarded body to the output file + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! SyMBA nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + + associate(pl => self%pl, npl => self%pl%nbody, pl_adds => self%pl_adds) + + if (self%tp_discards%nbody > 0) call self%tp_discards%write_info(param%system_history%nc, param) + if (self%pl_discards%nbody == 0) return + + call self%pl_discards%write_info(param%system_history%nc, param) + end associate + + return + + end subroutine swiftest_io_write_discard + + + module subroutine swiftest_io_write_frame_system(self, param) + !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Write a frame (header plus records for each massive body and active test particle) to output binary file + !! There is no direct file output from this subroutine + !! + !! Adapted from David E. Kaufmann's Swifter routine io_write_frame.f90 + !! Adapted from Hal Levison's Swift routine io_write_frame.f + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + logical, save :: lfirst = .true. !! Flag to determine if this is the first call of this method + character(len=STRMAX) :: errmsg + logical :: fileExists + + associate (nc => param%system_history%nc, pl => self%pl, tp => self%tp, npl => self%pl%nbody, ntp => self%tp%nbody) + nc%name_chunk = npl + ntp + nc%time_chunk = max(param%dump_cadence / param%istep_out, 1) + nc%file_name = param%outfile + if (lfirst) then + inquire(file=param%outfile, exist=fileExists) + + select case(param%out_stat) + case('APPEND') + if (.not.fileExists) then + errmsg = param%outfile // " not found! You must specify OUT_STAT = NEW, REPLACE, or UNKNOWN" + goto 667 + end if + case('NEW') + if (fileExists) then + errmsg = param%outfile // " Alread Exists! You must specify OUT_STAT = APPEND, REPLACE, or UNKNOWN" + goto 667 + end if + call nc%initialize(param) + case('REPLACE', 'UNKNOWN') + call nc%initialize(param) + end select + + lfirst = .false. + end if + + call self%write_frame(nc, param) + end associate + + return + + 667 continue + write(*,*) "Error writing nbody_system frame: " // trim(adjustl(errmsg)) + call util_exit(FAILURE) + end subroutine swiftest_io_write_frame_system + +end submodule s_swiftest_io diff --git a/src/kick/kick.f90 b/src/swiftest/swiftest_kick.f90 similarity index 76% rename from src/kick/kick.f90 rename to src/swiftest/swiftest_kick.f90 index dd0682bf0..23740432a 100644 --- a/src/kick/kick.f90 +++ b/src/swiftest/swiftest_kick.f90 @@ -7,11 +7,9 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(swiftest_classes) s_kick - use swiftest +submodule(swiftest) s_swiftest_kick contains - - module subroutine kick_getacch_int_pl(self, param) + module subroutine swiftest_kick_getacch_int_pl(self, param) !! author: David A. Minton !! !! Compute direct cross (third) term heliocentric accelerations of massive bodies @@ -23,47 +21,47 @@ module subroutine kick_getacch_int_pl(self, param) class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters ! Internals - type(interaction_timer), save :: itimer + ! type(interaction_timer), save :: itimer logical, save :: lfirst = .true. - if (param%ladaptive_interactions) then - if (self%nplpl > 0) then - if (lfirst) then - write(itimer%loopname, *) "kick_getacch_int_pl" - write(itimer%looptype, *) "INTERACTION" - call itimer%time_this_loop(param, self%nplpl, self) - lfirst = .false. - else - if (itimer%check(param, self%nplpl)) call itimer%time_this_loop(param, self%nplpl, self) - end if - else - param%lflatten_interactions = .false. - end if - end if - - if (param%lflatten_interactions) then + ! if (param%ladaptive_interactions) then + ! if (self%nplpl > 0) then + ! if (lfirst) then + ! write(itimer%loopname, *) "kick_getacch_int_pl" + ! write(itimer%looptype, *) "INTERACTION" + ! call itimer%time_this_loop(param, self%nplpl, self) + ! lfirst = .false. + ! else + ! if (itimer%netcdf_io_check(param, self%nplpl)) call itimer%time_this_loop(param, self%nplpl, self) + ! end if + ! else + ! param%lflatten_interactions = .false. + ! end if + ! end if + + ! if (param%lflatten_interactions) then + ! if (param%lclose) then + ! call swiftest_kick_getacch_int_all_flat_pl(self%nbody, self%nplpl, self%k_plpl, self%rh, self%Gmass, self%radius, self%ah) + ! else + ! call swiftest_kick_getacch_int_all_flat_pl(self%nbody, self%nplpl, self%k_plpl, self%rh, self%Gmass, acc=self%ah) + ! end if + ! else if (param%lclose) then - call kick_getacch_int_all_flat_pl(self%nbody, self%nplpl, self%k_plpl, self%xh, self%Gmass, self%radius, self%ah) + call swiftest_kick_getacch_int_all_triangular_pl(self%nbody, self%nbody, self%rh, self%Gmass, self%radius, self%ah) else - call kick_getacch_int_all_flat_pl(self%nbody, self%nplpl, self%k_plpl, self%xh, self%Gmass, acc=self%ah) + call swiftest_kick_getacch_int_all_triangular_pl(self%nbody, self%nbody, self%rh, self%Gmass, acc=self%ah) end if - else - if (param%lclose) then - call kick_getacch_int_all_triangular_pl(self%nbody, self%nbody, self%xh, self%Gmass, self%radius, self%ah) - else - call kick_getacch_int_all_triangular_pl(self%nbody, self%nbody, self%xh, self%Gmass, acc=self%ah) - end if - end if + ! end if - if (param%ladaptive_interactions .and. self%nplpl > 0) then - if (itimer%is_on) call itimer%adapt(param, self%nplpl, self) - end if + ! if (param%ladaptive_interactions .and. self%nplpl > 0) then + ! if (itimer%is_on) call itimer%adapt(param, self%nplpl, self) + ! end if return - end subroutine kick_getacch_int_pl + end subroutine swiftest_kick_getacch_int_pl - module subroutine kick_getacch_int_tp(self, param, GMpl, xhp, npl) + module subroutine swiftest_kick_getacch_int_tp(self, param, GMpl, rhp, npl) !! author: David A. Minton !! !! Compute direct cross (third) term heliocentric accelerations of test particles by massive bodies @@ -75,18 +73,18 @@ module subroutine kick_getacch_int_tp(self, param, GMpl, xhp, npl) 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) :: xhp !! Massive body position vectors + real(DP), dimension(:,:), intent(in) :: rhp !! Massive body position vectors integer(I4B), intent(in) :: npl !! Number of active massive bodies if ((self%nbody == 0) .or. (npl == 0)) return - call kick_getacch_int_all_tp(self%nbody, npl, self%xh, xhp, GMpl, self%lmask, self%ah) + call swiftest_kick_getacch_int_all_tp(self%nbody, npl, self%rh, rhp, GMpl, self%lmask, self%ah) return - end subroutine kick_getacch_int_tp + end subroutine swiftest_kick_getacch_int_tp - module subroutine kick_getacch_int_all_flat_pl(npl, nplpl, k_plpl, x, Gmass, radius, acc) + module subroutine swiftest_kick_getacch_int_all_flat_pl(npl, nplpl, k_plpl, x, Gmass, radius, acc) !! author: David A. Minton !! !! Compute direct cross (third) term heliocentric accelerations for massive bodies, with parallelization. @@ -126,7 +124,7 @@ module subroutine kick_getacch_int_all_flat_pl(npl, nplpl, k_plpl, x, Gmass, rad zr = x(3, j) - x(3, i) rji2 = xr**2 + yr**2 + zr**2 rlim2 = (radius(i) + radius(j))**2 - if (rji2 > rlim2) call kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmass(i), Gmass(j), & + if (rji2 > rlim2) call swiftest_kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmass(i), Gmass(j), & ahi(1,i), ahi(2,i), ahi(3,i), ahj(1,j), ahj(2,j), ahj(3,j)) end do !$omp end parallel do @@ -143,7 +141,7 @@ module subroutine kick_getacch_int_all_flat_pl(npl, nplpl, k_plpl, x, Gmass, rad yr = x(2, j) - x(2, i) zr = x(3, j) - x(3, i) rji2 = xr**2 + yr**2 + zr**2 - call kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmass(i), Gmass(j), & + call swiftest_kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmass(i), Gmass(j), & ahi(1,i), ahi(2,i), ahi(3,i), ahj(1,j), ahj(2,j), ahj(3,j)) end do !$omp end parallel do @@ -152,10 +150,10 @@ module subroutine kick_getacch_int_all_flat_pl(npl, nplpl, k_plpl, x, Gmass, rad acc(:,:) = acc(:,:) + ahi(:,:) + ahj(:,:) return - end subroutine kick_getacch_int_all_flat_pl + end subroutine swiftest_kick_getacch_int_all_flat_pl - module subroutine kick_getacch_int_all_triangular_pl(npl, nplm, x, Gmass, radius, acc) + module subroutine swiftest_kick_getacch_int_all_triangular_pl(npl, nplm, x, Gmass, radius, acc) !! author: David A. Minton !! !! Compute direct cross (third) term heliocentric accelerations for massive bodies, with parallelization. @@ -192,7 +190,7 @@ module subroutine kick_getacch_int_all_triangular_pl(npl, nplm, x, Gmass, radius zr = x(3, j) - x(3, i) rji2 = xr**2 + yr**2 + zr**2 rlim2 = (radius(i) + radius(j))**2 - if (rji2 > rlim2) call kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmass(i), Gmass(j), & + if (rji2 > rlim2) call swiftest_kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmass(i), Gmass(j), & ahi(1,i), ahi(2,i), ahi(3,i), ahj(1,j), ahj(2,j), ahj(3,j)) end do end do @@ -209,7 +207,7 @@ module subroutine kick_getacch_int_all_triangular_pl(npl, nplm, x, Gmass, radius yr = x(2, j) - x(2, i) zr = x(3, j) - x(3, i) rji2 = xr**2 + yr**2 + zr**2 - call kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmass(i), Gmass(j), & + call swiftest_kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmass(i), Gmass(j), & ahi(1,i), ahi(2,i), ahi(3,i), ahj(1,j), ahj(2,j), ahj(3,j)) end do end do @@ -221,10 +219,10 @@ module subroutine kick_getacch_int_all_triangular_pl(npl, nplm, x, Gmass, radius end do return - end subroutine kick_getacch_int_all_triangular_pl + end subroutine swiftest_kick_getacch_int_all_triangular_pl - module subroutine kick_getacch_int_all_tp(ntp, npl, xtp, xpl, GMpl, lmask, acc) + module subroutine swiftest_kick_getacch_int_all_tp(ntp, npl, xtp, rpl, GMpl, lmask, acc) !! author: David A. Minton !! !! Compute direct cross (third) term heliocentric accelerations of test particles by massive bodies with parallelisim @@ -235,7 +233,7 @@ module subroutine kick_getacch_int_all_tp(ntp, npl, xtp, xpl, GMpl, lmask, acc) integer(I4B), intent(in) :: ntp !! Number of test particles integer(I4B), intent(in) :: npl !! Number of massive bodies real(DP), dimension(:,:), intent(in) :: xtp !! Test particle position vector array - real(DP), dimension(:,:), intent(in) :: xpl !! Massive body 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 @@ -245,26 +243,26 @@ module subroutine kick_getacch_int_all_tp(ntp, npl, xtp, xpl, GMpl, lmask, acc) integer(I4B) :: i, j !$omp parallel do default(private) schedule(static)& - !$omp shared(npl, ntp, lmask, xtp, xpl, GMpl) & + !$omp shared(npl, ntp, lmask, xtp, rpl, GMpl) & !$omp reduction(-:acc) do i = 1, ntp if (lmask(i)) then do j = 1, npl - xr = xtp(1, i) - xpl(1, j) - yr = xtp(2, i) - xpl(2, j) - zr = xtp(3, i) - xpl(3, j) + xr = xtp(1, i) - rpl(1, j) + yr = xtp(2, i) - rpl(2, j) + zr = xtp(3, i) - rpl(3, j) rji2 = xr**2 + yr**2 + zr**2 - call kick_getacch_int_one_tp(rji2, xr, yr, zr, GMpl(j), acc(1,i), acc(2,i), acc(3,i)) + call swiftest_kick_getacch_int_one_tp(rji2, xr, yr, zr, GMpl(j), acc(1,i), acc(2,i), acc(3,i)) end do end if end do !$omp end parallel do return - end subroutine kick_getacch_int_all_tp + end subroutine swiftest_kick_getacch_int_all_tp - pure module subroutine kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmi, Gmj, axi, ayi, azi, axj, ayj, azj) + pure module subroutine swiftest_kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmi, Gmj, axi, ayi, azi, axj, ayj, azj) !! author: David A. Minton !! !! Compute direct cross (third) term heliocentric accelerations for a single pair of massive bodies @@ -292,10 +290,10 @@ pure module subroutine kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmi, Gmj, axi, azj = azj - faci * zr return - end subroutine kick_getacch_int_one_pl + end subroutine swiftest_kick_getacch_int_one_pl - pure module subroutine kick_getacch_int_one_tp(rji2, xr, yr, zr, GMpl, ax, ay, az) + pure module subroutine swiftest_kick_getacch_int_one_tp(rji2, xr, yr, zr, GMpl, ax, ay, az) !! author: David A. Minton !! !! Compute direct cross (third) term heliocentric accelerations of a single test particle massive body pair. @@ -316,6 +314,6 @@ pure module subroutine kick_getacch_int_one_tp(rji2, xr, yr, zr, GMpl, ax, ay, a az = az - fac * zr return - end subroutine kick_getacch_int_one_tp + end subroutine swiftest_kick_getacch_int_one_tp -end submodule s_kick +end submodule s_swiftest_kick diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 new file mode 100644 index 000000000..4d08eddf8 --- /dev/null +++ b/src/swiftest/swiftest_module.f90 @@ -0,0 +1,1910 @@ +!! 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. + +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. + !! + !! 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. + !! + !! 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 + use globals + use operators + use lambda_function + use base + use encounter + use collision + use walltime + use io_progress_bar + use netcdf_io + use solver + !use advisor_annotate + !$ use omp_lib + implicit none + public + + 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 :: 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 + final :: swiftest_final_netcdf_parameters !! Finalizer will close the NetCDF file + end type swiftest_netcdf_parameters + + + type, extends(base_storage) :: swiftest_storage + 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 :: 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. + type, extends(base_parameters) :: swiftest_parameters + type(swiftest_storage(nframes=:)), allocatable :: system_history + contains + procedure :: dump => swiftest_io_dump_param + procedure :: reader => swiftest_io_param_reader + procedure :: writer => swiftest_io_param_writer + procedure :: read_in => swiftest_io_read_in_param + procedure :: set_display => swiftest_io_set_display_param + end type swiftest_parameters + + + !> 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 + contains + procedure :: dealloc => swiftest_util_dealloc_kin !! Deallocates all allocatable arrays + final :: swiftest_final_kin !! Finalizes the Swiftest kinship object - deallocates all allocatables + end type swiftest_kinship + + + !> 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 + integer(I4B) :: nbody = 0 !! Number of bodies + logical :: lfirst = .true. !! Run the current step as a first + integer(I4B), dimension(:), allocatable :: id !! External identifier (unique) + 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 + procedure(abstract_set_mu), deferred :: set_mu + procedure(abstract_step_body), deferred :: step + 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 :: accel_obl => swiftest_obl_acc_body !! Compute the barycentric accelerations of bodies due to the oblateness of the central body + 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 + end type swiftest_body + + + 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) + 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 + end type swiftest_particle_info + + + 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 + contains + 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 + 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 !! 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_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) + generic :: set_renc => set_renc_I4B, set_renc_DP + 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 + 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) + 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(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file + class(collision_storage(nframes=:)), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file + + 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) :: Lorbit = 0.0_DP !! nbody_system orbital angular momentum vector + real(DP), dimension(NDIM) :: Lspin = 0.0_DP !! nbody_system spin angular momentum vector + real(DP), dimension(NDIM) :: Ltot = 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 binding energy + real(DP) :: Eorbit_orig = 0.0_DP !! Initial orbital energy + real(DP) :: GMtot_orig = 0.0_DP !! Initial nbody_system mass + real(DP), dimension(NDIM) :: Ltot_orig = 0.0_DP !! Initial total angular momentum vector + real(DP), dimension(NDIM) :: Lorbit_orig = 0.0_DP !! Initial orbital angular momentum + real(DP), dimension(NDIM) :: Lspin_orig = 0.0_DP !! Initial spin angular momentum vector + real(DP), dimension(NDIM) :: Lescape = 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) :: Ecollisions = 0.0_DP !! Energy lost from nbody_system due to collisions + real(DP) :: Euntracked = 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 + real(DP) :: ke_spin_error = 0.0_DP + real(DP) :: pe_error = 0.0_DP + real(DP) :: be_error = 0.0_DP + real(DP) :: Eorbit_error = 0.0_DP + real(DP) :: Ecoll_error = 0.0_DP + real(DP) :: Euntracked_error = 0.0_DP + real(DP) :: Etot_error = 0.0_DP + real(DP) :: Lorbit_error = 0.0_DP + real(DP) :: Lspin_error = 0.0_DP + real(DP) :: Lescape_error = 0.0_DP + real(DP) :: Ltot_error = 0.0_DP + 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 + 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 :: dump => swiftest_io_dump_system !! Dump the state of the nbody_system to a file + procedure :: get_old_t_final => swiftest_io_netcdf_get_old_t_final_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 :: write_frame_netcdf => swiftest_io_netcdf_write_frame_system !! Write a frame of input data from file + procedure :: write_frame_system => swiftest_io_write_frame_system !! Write 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_in => swiftest_io_read_in_system !! Reads the initial conditions for an nbody system + procedure :: read_particle_info => swiftest_io_netcdf_read_particle_info_system !! Read in particle metadata 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 :: 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 :: get_energy_and_momentum => swiftest_util_get_energy_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 :: validate_ids => swiftest_util_valid_id_system !! Validate the numerical ids passed to the nbody_system and save the maximum value + procedure :: write_discard => swiftest_io_write_discard !! Write out information about discarded and merged planets and test particles in SyMBA + generic :: write_frame => write_frame_system, write_frame_netcdf !! Generic method call for reading a frame of output data + end type swiftest_nbody_system + + + abstract interface + + 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 + 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 + 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. + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + end subroutine swiftest_drift_body + + pure elemental module subroutine swiftest_drift_one(mu, px, py, pz, 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) :: px, py, pz, 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 + + 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 + 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 + end subroutine swiftest_gr_kick_getacch + + pure module subroutine swiftest_gr_p4_pos_kick(param, x, v, dt) + implicit none + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + real(DP), dimension(:), intent(inout) :: x !! Position vector + real(DP), dimension(:), intent(in) :: v !! 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 + 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 + 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) + 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 + 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 + 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 + end subroutine swiftest_io_conservation_report + + 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) + end subroutine swiftest_io_dump_param + + module subroutine swiftest_io_dump_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 + 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 + end subroutine swiftest_io_dump_storage + + module subroutine swiftest_io_get_args(integrator, param_file_name, display_style) + 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" + 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 + 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) :: 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 + 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 + end subroutine swiftest_io_netcdf_flush + + module function swiftest_io_netcdf_get_old_t_final_system(self, param) result(old_t_final) + 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) :: old_t_final !! Final time from last run + end function swiftest_io_netcdf_get_old_t_final_system + + 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 + 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(in) :: 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + end subroutine swiftest_io_netcdf_write_info_cb + + module subroutine swiftest_io_write_discard(self, param) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! SyMBA nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_io_write_discard + + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + end subroutine swiftest_io_param_writer_one_logical + + 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 + end subroutine swiftest_io_param_writer_one_QP + end interface io_param_writer_one + + interface + + 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 + 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 + 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) + end subroutine swiftest_io_read_in_param + + module subroutine swiftest_io_read_in_system(self, param) + implicit none + class(swiftest_nbody_system), intent(inout) :: self + 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 + 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 + 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 + end subroutine swiftest_io_set_display_param + + module subroutine swiftest_io_toupper(string) + implicit none + character(*), intent(inout) :: string !! String to make upper case + end subroutine swiftest_io_toupper + + module subroutine swiftest_io_write_frame_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 + end subroutine swiftest_io_write_frame_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 + 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 + end subroutine swiftest_kick_getacch_int_tp + + module subroutine swiftest_kick_getacch_int_all_flat_pl(npl, nplpl, k_plpl, x, 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) :: x !! Position vector array + real(DP), dimension(:), intent(in) :: Gmass !! Array of massive body G*mass + real(DP), dimension(:), intent(in), optional :: radius !! Array of massive body radii + real(DP), dimension(:,:), intent(inout) :: acc !! Acceleration vector array + end subroutine swiftest_kick_getacch_int_all_flat_pl + + module subroutine swiftest_kick_getacch_int_all_triangular_pl(npl, nplm, x, 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) :: x !! Position vector array + real(DP), dimension(:), intent(in) :: Gmass !! Array of massive body G*mass + real(DP), dimension(:), intent(in), optional :: radius !! Array of massive body radii + real(DP), dimension(:,:), intent(inout) :: acc !! Acceleration vector array + end subroutine swiftest_kick_getacch_int_all_triangular_pl + + module subroutine swiftest_kick_getacch_int_all_tp(ntp, npl, xtp, 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) :: xtp !! 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 + + 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 + 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 + end subroutine swiftest_kick_getacch_int_one_tp + + module subroutine swiftest_obl_acc_body(self, nbody_system) + implicit none + class(swiftest_body), intent(inout) :: self !! Swiftest body object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + end subroutine swiftest_obl_acc_body + + module subroutine swiftest_obl_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 + + module subroutine swiftest_obl_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 + + module subroutine swiftest_obl_pot_system(self) + implicit none + 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 + end subroutine swiftest_orbel_el2xv_vec + + pure module subroutine swiftest_orbel_scget(angle, sx, cx) + !$omp declare simd(swiftest_orbel_scget) + implicit none + real(DP), intent(in) :: angle + real(DP), intent(out) :: sx, cx + end subroutine swiftest_orbel_scget + + pure elemental module subroutine swiftest_orbel_xv2aeq(mu, px, py, pz, 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) :: px,py,pz !! 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, px, py, pz, 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) :: px,py,pz !! 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, px, py, pz, 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) :: px,py,pz !! 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 + 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 + 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 + 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 + end subroutine swiftest_util_setup_initialize_particle_info_system + + module subroutine swiftest_util_setup_initialize_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 + 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 + 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 + 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 + end subroutine swiftest_user_kick_getacch_body + end interface + + interface swiftest_util_append + module subroutine swiftest_util_append_arr_char_string(arr, source, nold, nsrc, lsource_mask) + implicit none + 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) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + end subroutine swiftest_util_append_arr_char_string + + module subroutine swiftest_util_append_arr_DP(arr, source, nold, nsrc, lsource_mask) + implicit none + real(DP), dimension(:), allocatable, intent(inout) :: arr !! Destination array + real(DP), dimension(:), allocatable, intent(in) :: source !! Array to append + integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + end subroutine swiftest_util_append_arr_DP + + module subroutine swiftest_util_append_arr_DPvec(arr, source, nold, nsrc, lsource_mask) + implicit none + real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Destination array + real(DP), dimension(:,:), allocatable, intent(in) :: source !! Array to append + integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + end subroutine swiftest_util_append_arr_DPvec + + module subroutine swiftest_util_append_arr_I4B(arr, source, nold, nsrc, lsource_mask) + implicit none + integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Destination array + integer(I4B), dimension(:), allocatable, intent(in) :: source !! Array to append + integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + end subroutine swiftest_util_append_arr_I4B + + module subroutine swiftest_util_append_arr_info(arr, source, nold, nsrc, 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) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: 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, nsrc, 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) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + end subroutine swiftest_util_append_arr_kin + + module subroutine swiftest_util_append_arr_logical(arr, source, nold, nsrc, lsource_mask) + implicit none + logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array + logical, dimension(:), allocatable, intent(in) :: source !! Array to append + integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + end subroutine swiftest_util_append_arr_logical + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + end subroutine swiftest_util_coord_rh2rb_tp + + module subroutine swiftest_util_copy_particle_info(self, source) + implicit none + class(swiftest_particle_info), intent(inout) :: self + class(swiftest_particle_info), intent(in) :: source + 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 + end subroutine swiftest_util_copy_particle_info_arr + + module subroutine swiftest_util_dealloc_body(self) + implicit none + class(swiftest_body), intent(inout) :: self + end subroutine swiftest_util_dealloc_body + + module subroutine swiftest_util_dealloc_kin(self) + implicit none + class(swiftest_kinship), intent(inout) :: self !! Swiftest kinship object + end subroutine swiftest_util_dealloc_kin + + module subroutine swiftest_util_dealloc_pl(self) + implicit none + class(swiftest_pl), intent(inout) :: self + end subroutine swiftest_util_dealloc_pl + + module subroutine swiftest_util_dealloc_tp(self) + implicit none + class(swiftest_tp), intent(inout) :: self + 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 + 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 + 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 + end subroutine swiftest_util_fill_tp + end interface + + interface swiftest_util_fill + module subroutine swiftest_util_fill_arr_char_string(keeps, inserts, lfill_list) + implicit none + 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 + end subroutine swiftest_util_fill_arr_char_string + + module subroutine swiftest_util_fill_arr_DP(keeps, inserts, lfill_list) + implicit none + 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 + end subroutine swiftest_util_fill_arr_DP + + module subroutine swiftest_util_fill_arr_DPvec(keeps, inserts, lfill_list) + implicit none + 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 + end subroutine swiftest_util_fill_arr_DPvec + + module subroutine swiftest_util_fill_arr_I4B(keeps, inserts, lfill_list) + implicit none + 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 + end subroutine swiftest_util_fill_arr_I4B + + 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 + 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 + end subroutine swiftest_util_fill_arr_kin + + module subroutine swiftest_util_fill_arr_logical(keeps, inserts, lfill_list) + implicit none + 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 + end subroutine swiftest_util_fill_arr_logical + end interface + + interface + + 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 + 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 + 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 + 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 + end subroutine + + 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 + 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 + 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 + end subroutine swiftest_util_index_map_storage + + 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 + 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 + 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 + end subroutine swiftest_util_rearray_pl + + 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. + 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 + end subroutine swiftest_util_reset_kinship_pl + + module subroutine swiftest_util_reset_storage(self) + implicit none + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + end subroutine swiftest_util_reset_storage + end interface + + + interface swiftest_util_resize + module subroutine swiftest_util_resize_arr_char_string(arr, nnew) + implicit none + character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + end subroutine swiftest_util_resize_arr_char_string + + module subroutine swiftest_util_resize_arr_DP(arr, nnew) + implicit none + real(DP), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + end subroutine swiftest_util_resize_arr_DP + + module subroutine swiftest_util_resize_arr_DPvec(arr, nnew) + implicit none + real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + end subroutine swiftest_util_resize_arr_DPvec + + module subroutine swiftest_util_resize_arr_I4B(arr, nnew) + implicit none + integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + end subroutine swiftest_util_resize_arr_I4B + + 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 + 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 + end subroutine swiftest_util_resize_arr_kin + + module subroutine swiftest_util_resize_arr_logical(arr, nnew) + implicit none + logical, dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + end subroutine swiftest_util_resize_arr_logical + 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 + 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 + end subroutine swiftest_util_resize_pl + + 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 + end subroutine swiftest_util_resize_tp + + module subroutine swiftest_util_get_energy_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 + end subroutine swiftest_util_get_energy_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 + end subroutine swiftest_util_get_idvalues_system + + 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 + 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 + 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 + 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 + 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 + 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) + 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 + 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) + 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) + 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 + end subroutine swiftest_util_set_rhill_approximate + + 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 encounter snapshots) + end subroutine swiftest_util_snapshot_system + end interface + + + interface swiftest_util_sort + pure module subroutine swiftest_util_sort_i4b(arr) + implicit none + integer(I4B), dimension(:), intent(inout) :: arr + end subroutine swiftest_util_sort_i4b + + pure module subroutine swiftest_util_sort_index_i4b(arr,ind) + implicit none + integer(I4B), dimension(:), intent(in) :: arr + integer(I4B), dimension(:), allocatable, intent(inout) :: ind + end subroutine swiftest_util_sort_index_i4b + + pure module subroutine swiftest_util_sort_index_I4B_I8Bind(arr,ind) + implicit none + integer(I4B), dimension(:), intent(in) :: arr + integer(I8B), dimension(:), allocatable, intent(inout) :: ind + end subroutine swiftest_util_sort_index_I4b_I8Bind + + pure module subroutine swiftest_util_sort_index_I8B_I8Bind(arr,ind) + implicit none + integer(I8B), dimension(:), intent(in) :: arr + integer(I8B), dimension(:), allocatable, intent(inout) :: ind + end subroutine swiftest_util_sort_index_I8B_I8Bind + + pure module subroutine swiftest_util_sort_sp(arr) + implicit none + real(SP), dimension(:), intent(inout) :: arr + end subroutine swiftest_util_sort_sp + + pure module subroutine swiftest_util_sort_index_sp(arr,ind) + implicit none + real(SP), dimension(:), intent(in) :: arr + integer(I4B), dimension(:), allocatable, intent(inout) :: ind + end subroutine swiftest_util_sort_index_sp + + pure module subroutine swiftest_util_sort_dp(arr) + implicit none + real(DP), dimension(:), intent(inout) :: arr + end subroutine swiftest_util_sort_dp + + pure module subroutine swiftest_util_sort_index_dp(arr,ind) + implicit none + real(DP), dimension(:), intent(in) :: arr + integer(I4B), dimension(:), allocatable, intent(inout) :: ind + end subroutine swiftest_util_sort_index_dp + end interface swiftest_util_sort + + interface swiftest_util_sort_rearrange + pure module subroutine swiftest_util_sort_rearrange_arr_char_string(arr, ind, n) + implicit none + 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 + end subroutine swiftest_util_sort_rearrange_arr_char_string + + pure module subroutine swiftest_util_sort_rearrange_arr_DP(arr, ind, n) + implicit none + 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 + end subroutine swiftest_util_sort_rearrange_arr_DP + + pure module subroutine swiftest_util_sort_rearrange_arr_DPvec(arr, ind, n) + implicit none + 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 + end subroutine swiftest_util_sort_rearrange_arr_DPvec + + pure module subroutine swiftest_util_sort_rearrange_arr_I4B(arr, ind, n) + implicit none + 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 + end subroutine swiftest_util_sort_rearrange_arr_I4B + + pure module subroutine swiftest_util_sort_rearrange_arr_I4B_I8Bind(arr, ind, n) + implicit none + 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 + end subroutine swiftest_util_sort_rearrange_arr_I4B_I8Bind + + 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 + 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 + end subroutine swiftest_util_sort_rearrange_arr_kin + + pure module subroutine swiftest_util_sort_rearrange_arr_logical(arr, ind, n) + implicit none + 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 + end subroutine swiftest_util_sort_rearrange_arr_logical + + pure module subroutine swiftest_util_sort_rearrange_arr_logical_I8Bind(arr, ind, n) + implicit none + 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 + end subroutine swiftest_util_sort_rearrange_arr_logical_I8Bind + end interface swiftest_util_sort_rearrange + + 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) + 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) + 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) + 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 + 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 + 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 + end subroutine swiftest_util_sort_tp + + end interface + + interface swiftest_util_spill + module subroutine swiftest_util_spill_arr_char_string(keeps, discards, lspill_list, ldestructive) + implicit none + 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 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_char_string + + module subroutine swiftest_util_spill_arr_DP(keeps, discards, lspill_list, ldestructive) + implicit none + 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 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_arr_DP + + module subroutine swiftest_util_spill_arr_DPvec(keeps, discards, lspill_list, ldestructive) + implicit none + 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 + end subroutine swiftest_util_spill_arr_DPvec + + module subroutine swiftest_util_spill_arr_I4B(keeps, discards, lspill_list, ldestructive) + implicit none + 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 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_I4B + + module subroutine swiftest_util_spill_arr_I8B(keeps, discards, lspill_list, ldestructive) + implicit none + 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 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_I8B + + 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 + 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 + end subroutine swiftest_util_spill_arr_kin + + module subroutine swiftest_util_spill_arr_logical(keeps, discards, lspill_list, ldestructive) + implicit none + 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 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_logical + 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 + 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 + 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 + end subroutine swiftest_util_spill_tp + + end interface + + interface swiftest_util_unique + module subroutine swiftest_util_unique_DP(input_array, output_array, index_map) + implicit none + 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) + end subroutine swiftest_util_unique_DP + + module subroutine swiftest_util_unique_I4B(input_array, output_array, index_map) + implicit none + 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) + end subroutine swiftest_util_unique_I4B + end interface swiftest_util_unique + + 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 + end subroutine swiftest_util_valid_id_system + + module subroutine swiftest_util_version() + implicit none + end subroutine swiftest_util_version + end interface + + contains + subroutine swiftest_make_impactors_pl(self, idx) + !! author: David A. Minton + !! + !! This is a simple wrapper function that is used to make a type-bound procedure using a subroutine whose interface is in the collision module, which must be defined first + 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) + + call collision_resolve_make_impactors_pl(self, idx) + + return + end subroutine swiftest_make_impactors_pl + + + subroutine swiftest_final_kin(self) + !! author: David A. Minton + !! + !! Finalize the swiftest kinship object - deallocates all allocatables + implicit none + ! Argument + type(swiftest_kinship), intent(inout) :: self !! SyMBA kinship object + + call self%dealloc() + + return + end subroutine swiftest_final_kin + + + subroutine swiftest_final_netcdf_parameters(self) + !! author: David A. Minton + !! + !! Finalize the NetCDF by closing the file + implicit none + ! Arguments + type(swiftest_netcdf_parameters), intent(inout) :: self + + call self%close() + + return + end subroutine swiftest_final_netcdf_parameters + + + subroutine swiftest_final_storage(self) + !! author: David A. Minton + !! + !! Finalizer for the storage data type + implicit none + ! Arguments + type(swiftest_storage(*)) :: self + ! Internals + integer(I4B) :: i + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) + end do + + return + end subroutine swiftest_final_storage + + + subroutine swiftest_final_system(self) + !! author: David A. Minton + !! + !! Finalize the swiftest nbody system object - deallocates all allocatables + implicit none + ! Argument + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + + if (allocated(self%cb)) deallocate(self%cb) + if (allocated(self%pl)) deallocate(self%pl) + if (allocated(self%tp)) deallocate(self%tp) + if (allocated(self%tp_discards)) deallocate(self%tp_discards) + if (allocated(self%pl_discards)) deallocate(self%pl_discards) + + return + end subroutine swiftest_final_system + + +end module swiftest diff --git a/src/obl/obl.f90 b/src/swiftest/swiftest_obl.f90 similarity index 77% rename from src/obl/obl.f90 rename to src/swiftest/swiftest_obl.f90 index 9ae30a5e4..2b87b7264 100644 --- a/src/obl/obl.f90 +++ b/src/swiftest/swiftest_obl.f90 @@ -7,10 +7,9 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (swiftest_classes) s_obl - use swiftest +submodule (swiftest) s_swiftest_obl contains - module subroutine obl_acc_body(self, system) + module subroutine swiftest_obl_acc_body(self, nbody_system) !! author: David A. Minton !! !! Compute the barycentric accelerations of bodies due to the oblateness of the central body @@ -21,35 +20,35 @@ module subroutine obl_acc_body(self, system) implicit none ! Arguments class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object ! Internals integer(I4B) :: i real(DP) :: r2, irh, rinv2, t0, t1, t2, t3, fac1, fac2 if (self%nbody == 0) return - associate(n => self%nbody, cb => system%cb) + associate(n => self%nbody, cb => nbody_system%cb) self%aobl(:,:) = 0.0_DP do concurrent(i = 1:n, self%lmask(i)) - r2 = dot_product(self%xh(:, i), self%xh(:, i)) + r2 = dot_product(self%rh(:, i), self%rh(:, i)) irh = 1.0_DP / sqrt(r2) rinv2 = irh**2 t0 = -cb%Gmass * rinv2 * rinv2 * irh t1 = 1.5_DP * cb%j2rp2 - t2 = self%xh(3, i) * self%xh(3, i) * rinv2 + t2 = self%rh(3, i) * self%rh(3, i) * rinv2 t3 = 1.875_DP * cb%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) - self%aobl(:, i) = fac1 * self%xh(:, i) - self%aobl(3, i) = fac2 * self%xh(3, i) + self%aobl(3, i) + self%aobl(:, i) = fac1 * self%rh(:, i) + self%aobl(3, i) = fac2 * self%rh(3, i) + self%aobl(3, i) end do end associate return - end subroutine obl_acc_body + end subroutine swiftest_obl_acc_body - module subroutine obl_acc_pl(self, system) + module subroutine swiftest_obl_acc_pl(self, nbody_system) !! author: David A. Minton !! !! Compute the barycentric accelerations of massive bodies due to the oblateness of the central body @@ -59,14 +58,14 @@ module subroutine obl_acc_pl(self, system) implicit none ! Arguments class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object ! Internals integer(I4B) :: i if (self%nbody == 0) return - associate(pl => self, npl => self%nbody, cb => system%cb) - call obl_acc_body(pl, system) + associate(pl => self, npl => self%nbody, cb => nbody_system%cb) + call swiftest_obl_acc_body(pl, nbody_system) cb%aobl(:) = 0.0_DP do i = npl, 1, -1 if (pl%lmask(i)) cb%aobl(:) = cb%aobl(:) - pl%Gmass(i) * pl%aobl(:, i) / cb%Gmass @@ -79,10 +78,10 @@ module subroutine obl_acc_pl(self, system) return - end subroutine obl_acc_pl + end subroutine swiftest_obl_acc_pl - module subroutine obl_acc_tp(self, system) + module subroutine swiftest_obl_acc_tp(self, nbody_system) !! author: David A. Minton !! !! Compute the barycentric accelerations of massive bodies due to the oblateness of the central body @@ -92,16 +91,16 @@ module subroutine obl_acc_tp(self, system) implicit none ! Arguments class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object ! Internals real(DP), dimension(NDIM) :: aoblcb integer(I4B) :: i if (self%nbody == 0) return - associate(tp => self, ntp => self%nbody, cb => system%cb) - call obl_acc_body(tp, system) - if (system%lbeg) then + associate(tp => self, ntp => self%nbody, cb => nbody_system%cb) + call swiftest_obl_acc_body(tp, nbody_system) + if (nbody_system%lbeg) then aoblcb = cb%aoblbeg else aoblcb = cb%aoblend @@ -114,10 +113,10 @@ module subroutine obl_acc_tp(self, system) end associate return - end subroutine obl_acc_tp + end subroutine swiftest_obl_acc_tp - module subroutine obl_pot_system(self) + module subroutine swiftest_obl_pot_system(self) !! author: David A. Minton !! !! Compute the contribution to the total gravitational potential due solely to the oblateness of the central body @@ -134,19 +133,19 @@ module subroutine obl_pot_system(self) integer(I4B) :: i real(DP), dimension(self%pl%nbody) :: oblpot_arr - associate(system => self, pl => self%pl, npl => self%pl%nbody, cb => self%cb) + associate(nbody_system => self, pl => self%pl, npl => self%pl%nbody, cb => self%cb) if (.not. any(pl%lmask(1:npl))) return do concurrent (i = 1:npl, pl%lmask(i)) - oblpot_arr(i) = obl_pot_one(cb%Gmass, pl%Gmass(i), cb%j2rp2, cb%j4rp4, pl%xh(3,i), 1.0_DP / norm2(pl%xh(:,i))) + oblpot_arr(i) = swiftest_obl_pot_one(cb%Gmass, pl%Gmass(i), cb%j2rp2, cb%j4rp4, pl%rh(3,i), 1.0_DP / norm2(pl%rh(:,i))) end do - system%oblpot = sum(oblpot_arr, pl%lmask(1:npl)) + nbody_system%oblpot = sum(oblpot_arr, pl%lmask(1:npl)) end associate return - end subroutine obl_pot_system + end subroutine swiftest_obl_pot_system - elemental function obl_pot_one(GMcb, GMpl, j2rp2, j4rp4, zh, irh) result(oblpot) + 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 @@ -180,6 +179,6 @@ elemental function obl_pot_one(GMcb, GMpl, j2rp2, j4rp4, zh, irh) result(oblpot) oblpot = t0 * (t1 * p2 + t3 * p4) return - end function obl_pot_one + end function swiftest_obl_pot_one -end submodule s_obl +end submodule s_swiftest_obl diff --git a/src/orbel/orbel.f90 b/src/swiftest/swiftest_orbel.f90 similarity index 84% rename from src/orbel/orbel.f90 rename to src/swiftest/swiftest_orbel.f90 index 9dc68c397..d383f0eed 100644 --- a/src/orbel/orbel.f90 +++ b/src/swiftest/swiftest_orbel.f90 @@ -7,11 +7,10 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (swiftest_classes) s_orbel - use swiftest +submodule (swiftest) s_swiftest_orbel contains - module subroutine orbel_el2xv_vec(self, cb) + module subroutine swiftest_orbel_el2xv_vec(self, cb) !! author: David A. Minton !! !! A wrapper method that converts all of the orbital element vectors into cartesian position and velocity vectors for a Swiftest body object. @@ -27,15 +26,14 @@ module subroutine orbel_el2xv_vec(self, cb) call self%set_mu(cb) do concurrent (i = 1:self%nbody) - call orbel_el2xv(self%mu(i), self%a(i), self%e(i), self%inc(i), self%capom(i), & - self%omega(i), self%capm(i), self%xh(:, i), self%vh(:, i)) + call swiftest_orbel_el2xv(self%mu(i), self%a(i), self%e(i), self%inc(i), self%capom(i), & + self%omega(i), self%capm(i), self%rh(:, i), self%vh(:, i)) end do - deallocate(self%a, self%e, self%inc, self%capom, self%omega, self%capm) return - end subroutine orbel_el2xv_vec + end subroutine swiftest_orbel_el2xv_vec - pure subroutine orbel_el2xv(mu, a, ie, inc, capom, omega, capm, x, v) + pure subroutine swiftest_orbel_el2xv(mu, a, ie, inc, capom, omega, capm, x, v) !! author: David A. Minton !! !! Compute osculating orbital elements from relative C)rtesian position and velocity @@ -64,7 +62,7 @@ pure subroutine orbel_el2xv(mu, a, ie, inc, capom, omega, capm, x, v) if(ie < 0.0_DP) then - !write(*,*) ' ERROR in orbel_el2xv: e<0, setting e=0!!1' + !write(*,*) ' ERROR in swiftest_orbel_el2xv: e<0, setting e=0!!1' e = 0.0_DP iorbit_type = ELLIPSE else @@ -79,9 +77,9 @@ pure subroutine orbel_el2xv(mu, a, ie, inc, capom, omega, capm, x, v) end if endif - call orbel_scget(omega,sip,cip) - call orbel_scget(capom,so,co) - call orbel_scget(inc,si,ci) + call swiftest_orbel_scget(omega,sip,cip) + call swiftest_orbel_scget(capom,so,co) + call swiftest_orbel_scget(inc,si,ci) d11 = cip * co - sip * so * ci d12 = cip * so + sip * co * ci d13 = sip * si @@ -93,8 +91,8 @@ pure subroutine orbel_el2xv(mu, a, ie, inc, capom, omega, capm, x, v) ! Get the other quantities depending on orbit type ! if (iorbit_type == ELLIPSE) then - cape = orbel_ehybrid(e,capm) - call orbel_scget(cape,scap,ccap) + cape = swiftest_orbel_ehybrid(e,capm) + call swiftest_orbel_scget(cape,scap,ccap) sqe = sqrt(1._DP - e**2) sqgma = sqrt(mu* a) xfac1 = a * (ccap - e) @@ -105,8 +103,8 @@ pure subroutine orbel_el2xv(mu, a, ie, inc, capom, omega, capm, x, v) endif !-- if (iorbit_type == HYPERBOLA) then - capf = orbel_fhybrid(e,capm) - call orbel_schget(capf,shcap,chcap) + capf = swiftest_orbel_fhybrid(e,capm) + call swiftest_orbel_schget(capf,shcap,chcap) sqe = sqrt(e**2 - 1._DP ) sqgma = sqrt(mu * a) xfac1 = a * (e - chcap) @@ -117,7 +115,7 @@ pure subroutine orbel_el2xv(mu, a, ie, inc, capom, omega, capm, x, v) endif !-- if (iorbit_type == PARABOLA) then - zpara = orbel_zget(capm) + zpara = swiftest_orbel_zget(capm) sqgma = sqrt(2 * mu * a) xfac1 = a * (1._DP - zpara * zpara) xfac2 = 2 * a * zpara @@ -134,10 +132,10 @@ pure subroutine orbel_el2xv(mu, a, ie, inc, capom, omega, capm, x, v) v(3) = d13 * vfac1 + d23 * vfac2 return - end subroutine orbel_el2xv + end subroutine swiftest_orbel_el2xv - pure module subroutine orbel_scget(angle, sx, cx) + pure module subroutine swiftest_orbel_scget(angle, sx, cx) !! author: David A. Minton !! !! Efficiently compute the sine and cosine of an input angle @@ -162,14 +160,14 @@ pure module subroutine orbel_scget(angle, sx, cx) return - end subroutine orbel_scget + end subroutine swiftest_orbel_scget !********************************************************************** ! Code converted to Modern Fortran by David A. Minton ! Date: 2020-06-29 !********************************************************************** - ! ORBEL_SCHGET.F + ! swiftest_orbel_SCHGET.F !********************************************************************** ! PURPOSE: Given an angle, efficiently compute sinh and cosh. ! @@ -189,7 +187,7 @@ end subroutine orbel_scget ! DATE WRITTEN: May 6, 1992. ! REVISIONS: !********************************************************************** - pure subroutine orbel_schget(angle,shx,chx) + pure subroutine swiftest_orbel_schget(angle,shx,chx) real(DP), intent(in) :: angle real(DP), intent(out) :: shx,chx @@ -197,13 +195,13 @@ pure subroutine orbel_schget(angle,shx,chx) chx= sqrt(1._DP + shx * shx) return - end subroutine orbel_schget + end subroutine swiftest_orbel_schget !********************************************************************** ! Code converted to Modern Fortran by David A. Minton ! Date: 2020-06-29 - ! ! ORBEL_FLON.F + ! ! swiftest_orbel_FLON.F !********************************************************************** ! PURPOSE: Solves Kepler's eqn. for hyperbola using hybrid approach. ! @@ -211,7 +209,7 @@ end subroutine orbel_schget ! e ==> eccentricity anomaly. (real scalar) ! capn ==> hyperbola mean anomaly. (real scalar) ! Returns: - ! orbel_flon ==> eccentric anomaly. (real scalar) + ! swiftest_orbel_flon ==> eccentric anomaly. (real scalar) ! ! ALGORITHM: Uses power series for N in terms of F and Newton,s method ! REMARKS: ONLY GOOD FOR LOW VALUES OF N (N < 0.636*e -0.6) @@ -219,7 +217,7 @@ end subroutine orbel_schget ! DATE WRITTEN: May 26, 1992. ! REVISIONS: !********************************************************************** - real(DP) pure function orbel_flon(e,icapn) + real(DP) pure function swiftest_orbel_flon(e,icapn) implicit none real(DP), intent(in) :: e, icapn integer(I4B) :: iflag,i @@ -259,7 +257,7 @@ real(DP) pure function orbel_flon(e,icapn) biga = (-0.5_DP * b + sq)**(1.0_DP / 3.0_DP) bigb = -(+0.5_DP * b + sq)**(1.0_DP / 3.0_DP) x = biga + bigb - orbel_flon = x + swiftest_orbel_flon = x ! If capn is VSMALL (or zero) no need to go further than cubic even for ! e =1. if( capn >= VSMALL) then @@ -268,27 +266,27 @@ real(DP) pure function orbel_flon(e,icapn) f = a0 + x * (a1 + x2 * (a3 + x2 * (a5 + x2 * (a7 + x2 * (a9 + x2 * (a11 + x2)))))) fp = b1 + x2 * (b3 + x2 * (b5 + x2 * (b7 + x2 * (b9 + x2 * (b11 + 13 * x2))))) dx = -f / fp - orbel_flon = x + dx + swiftest_orbel_flon = x + dx ! if we have converged here there's no point in going on if(abs(dx) <= VSMALL) exit - x = orbel_flon + x = swiftest_orbel_flon end do end if ! normal return here, but check if capn was originally negative if(iflag == 1) then - orbel_flon = -orbel_flon + swiftest_orbel_flon = -swiftest_orbel_flon capn = -capn end if return - end function orbel_flon + end function swiftest_orbel_flon !********************************************************************** ! Code converted to Modern Fortran by David A. Minton ! Date: 2020-06-29 - ! ORBEL_FGET.F + ! swiftest_orbel_FGET.F !********************************************************************** ! PURPOSE: Solves Kepler's eqn. for hyperbola using hybrid approach. ! @@ -296,7 +294,7 @@ end function orbel_flon ! e ==> eccentricity anomaly. (real scalar) ! capn ==> hyperbola mean anomaly. (real scalar) ! Returns: - ! orbel_fget ==> eccentric anomaly. (real scalar) + ! swiftest_orbel_fget ==> eccentric anomaly. (real scalar) ! ! ALGORITHM: Based on pp. 70-72 of Fitzpatrick's book "Principles of ! Cel. Mech. ". Quartic convergence from Danby's book. @@ -305,7 +303,7 @@ end function orbel_flon ! DATE WRITTEN: May 11, 1992. ! REVISIONS: 2/26/93 hfl !********************************************************************** - real(DP) pure function orbel_fget(e,capn) + real(DP) pure function swiftest_orbel_fget(e,capn) implicit none real(DP), intent(in) :: e,capn @@ -330,10 +328,10 @@ real(DP) pure function orbel_fget(e,capn) x = log(tmp) end if - orbel_fget = x + swiftest_orbel_fget = x do i = 1, IMAX - call orbel_schget(x,shx,chx) + call swiftest_orbel_schget(x,shx,chx) esh = e * shx ech = e * chx f = esh - x - capn @@ -344,21 +342,21 @@ real(DP) pure function orbel_fget(e,capn) dx = -f / fp dx = -f / (fp + dx * fpp / 2._DP) dx = -f / (fp + dx * fpp / 2._DP + dx**2 * fppp / 6._DP) - orbel_fget = x + dx + swiftest_orbel_fget = x + dx ! if we have converged here there's no point in going on if(abs(dx) <= VSMALL) return - x = orbel_fget + x = swiftest_orbel_fget end do !write(*,*) 'fget : returning without complete convergence' return - end function orbel_fget + end function swiftest_orbel_fget !********************************************************************** ! Code converted to Modern Fortran by David A. Minton ! Date: 2020-06-29 - ! ORBEL_ZGET.F + ! swiftest_orbel_ZGET.F !********************************************************************** ! PURPOSE: Solves the equivalent of Kepler's eqn. for a parabola ! given Q (Fitz. notation.) @@ -366,7 +364,7 @@ end function orbel_fget ! Input: ! q ==> parabola mean anomaly. (real scalar) ! Returns: - ! orbel_zget ==> eccentric anomaly. (real scalar) + ! swiftest_orbel_zget ==> eccentric anomaly. (real scalar) ! ! ALGORITHM: p. 70-72 of Fitzpatrick's book "Princ. of Cel. Mech." ! REMARKS: For a parabola we can solve analytically. @@ -375,7 +373,7 @@ end function orbel_fget ! REVISIONS: May 27 - corrected it for negative Q and use power ! series for small Q. !********************************************************************** - real(DP) pure function orbel_zget(iq) + real(DP) pure function swiftest_orbel_zget(iq) implicit none real(DP), intent(in) :: iq @@ -392,26 +390,26 @@ real(DP) pure function orbel_zget(iq) end if if (q < 1.e-3_DP) then - orbel_zget = q * (1._DP - (q**2 / 3._DP) * (1._DP - q**2)) + swiftest_orbel_zget = q * (1._DP - (q**2 / 3._DP) * (1._DP - q**2)) else x = 0.5_DP * (3 * q + sqrt(9 * q**2 + 4._DP)) tmp = x**(1._DP / 3._DP) - orbel_zget = tmp - 1._DP / tmp + swiftest_orbel_zget = tmp - 1._DP / tmp end if if(iflag == 1) then - orbel_zget = -orbel_zget + swiftest_orbel_zget = -swiftest_orbel_zget q = -q end if return - end function orbel_zget + end function swiftest_orbel_zget !********************************************************************** ! Code converted to Modern Fortran by David A. Minton ! Date: 2020-06-29 - ! ORBEL_ESOLMD.F + ! swiftest_orbel_ESOLMD.F !********************************************************************** ! PURPOSE: Solves Kepler's eqn. e is ecc. m is mean anomaly. ! @@ -419,7 +417,7 @@ end function orbel_zget ! e ==> eccentricity anomaly. (real scalar) ! m ==> mean anomaly. (real scalar) ! Returns: - ! orbel_esolmd ==> eccentric anomaly. (real scalar) + ! swiftest_orbel_esolmd ==> eccentric anomaly. (real scalar) ! ! ALGORITHM: Some sort of quartic convergence from Wisdom. ! REMARKS: ONLY GOOD FOR SMALL ECCENTRICITY SINCE IT ONLY @@ -430,7 +428,7 @@ end function orbel_zget ! DATE WRITTEN: May 7, 1992. ! REVISIONS: 2/26/93 hfl !********************************************************************** - real(DP) pure function orbel_esolmd(e,m) + real(DP) pure function swiftest_orbel_esolmd(e,m) implicit none real(DP), intent(in) :: e @@ -442,10 +440,10 @@ real(DP) pure function orbel_esolmd(e,m) !... function to solve kepler's eqn for e (here called !... x) for given e and m. returns value of x. - call orbel_scget(m,sm,cm) + call swiftest_orbel_scget(m,sm,cm) x = m + e * sm * (1._DP + e * ( cm + e * (1._DP - 1.5_DP * sm**2))) - call orbel_scget(x,sx,cx) + call swiftest_orbel_scget(x,sx,cx) es = e * sx ec = e * cx f = x - es - m @@ -456,16 +454,16 @@ real(DP) pure function orbel_esolmd(e,m) dx = -f / (fp + dx * fpp / 2._DP) dx = -f / (fp + dx * fpp / 2._DP + dx**2 * fppp / 6._DP) - orbel_esolmd = x + dx + swiftest_orbel_esolmd = x + dx return - end function orbel_esolmd + end function swiftest_orbel_esolmd !********************************************************************** ! Code converted to Modern Fortran by David A. Minton ! Date: 2020-06-29 - ! ORBEL_EHIE.F + ! swiftest_orbel_EHIE.F !********************************************************************** ! PURPOSE: Solves Kepler's eqn. e is ecc. m is mean anomaly. ! @@ -473,7 +471,7 @@ end function orbel_esolmd ! e ==> eccentricity anomaly. (real scalar) ! m ==> mean anomaly. (real scalar) ! Returns: - ! orbel_ehybrid ==> eccentric anomaly. (real scalar) + ! swiftest_orbel_ehybrid ==> eccentric anomaly. (real scalar) ! ! ALGORITHM: Use Danby's quartic for 3 iterations. ! Eqn. is f(x) = x - e*sin(x+M). Note that @@ -485,7 +483,7 @@ end function orbel_esolmd ! DATE WRITTEN: May 25,1992. ! REVISIONS: !********************************************************************** - real(DP) pure function orbel_ehie(e,im) + real(DP) pure function swiftest_orbel_ehie(e,im) implicit none real(DP), intent(in) :: e,im @@ -513,7 +511,7 @@ real(DP) pure function orbel_ehie(e,im) ! iteration loop do niter =1,NMAX - call orbel_scget(x + m,sa,ca) + call swiftest_orbel_scget(x + m,sa,ca) esa = e * sa eca = e * ca f = x - esa @@ -524,21 +522,21 @@ real(DP) pure function orbel_ehie(e,im) x = x + dx end do - orbel_ehie = m + x + swiftest_orbel_ehie = m + x if (iflag == 1) then - orbel_ehie = TWOPI - orbel_ehie + swiftest_orbel_ehie = TWOPI - swiftest_orbel_ehie m = TWOPI - m end if return - end function orbel_ehie + end function swiftest_orbel_ehie !********************************************************************** ! Code converted to Modern Fortran by David A. Minton ! Date: 2020-06-29 - ! ORBEL_EGET.F + ! swiftest_orbel_EGET.F !********************************************************************** ! PURPOSE: Solves Kepler's eqn. e is ecc. m is mean anomaly. ! @@ -546,7 +544,7 @@ end function orbel_ehie ! e ==> eccentricity anomaly. (real scalar) ! m ==> mean anomaly. (real scalar) ! Returns: - ! orbel_eget ==> eccentric anomaly. (real scalar) + ! swiftest_orbel_eget ==> eccentric anomaly. (real scalar) ! ! ALGORITHM: Quartic convergence from Danby ! REMARKS: For results very near roundoff, give it M between @@ -560,7 +558,7 @@ end function orbel_ehie ! with the premise that it will only be called if ! we have an ellipse with e between 0.15 and 0.8 !********************************************************************** - real(DP) pure function orbel_eget(e,m) + real(DP) pure function swiftest_orbel_eget(e,m) implicit none real(DP), intent(in) :: e,m @@ -572,13 +570,13 @@ real(DP) pure function orbel_eget(e,m) ! may 21 : for e < 0.18 use esolmd for speed and sufficient accuracy ! may 21 : for e > 0.8 use ehie - this one may not converge fast enough. - call orbel_scget(m,sm,cm) + call swiftest_orbel_scget(m,sm,cm) ! begin with a guess accurate to order ecc**3 x = m + e * sm * ( 1._DP + e * (cm + e * (1._DP - 1.5_DP * sm * sm))) ! go through one iteration for improved estimate - call orbel_scget(x,sx,cx) + call swiftest_orbel_scget(x,sx,cx) es = e * sx ec = e * cx f = x - es - m @@ -588,14 +586,14 @@ real(DP) pure function orbel_eget(e,m) dx = -f / fp dx = -f / (fp + dx * fpp / 2._DP) dx = -f / (fp + dx * fpp / 2._DP + dx*2 * fppp / 6._DP) - orbel_eget = x + dx + swiftest_orbel_eget = x + dx ! do another iteration. ! for m between 0 and 2*pi this seems to be enough to ! get near roundoff error for eccentricities between 0 and 0.8 - x = orbel_eget - call orbel_scget(x,sx,cx) + x = swiftest_orbel_eget + call swiftest_orbel_scget(x,sx,cx) es = e * sx ec = e * cx f = x - es - m @@ -606,16 +604,16 @@ real(DP) pure function orbel_eget(e,m) dx = -f / (fp + dx * fpp / 2._DP) dx = -f / (fp + dx * fpp / 2._DP + dx**2 * fppp / 6._DP) - orbel_eget = x + dx + swiftest_orbel_eget = x + dx return - end function orbel_eget + end function swiftest_orbel_eget !********************************************************************** ! Code converted to Modern Fortran by David A. Minton ! Date: 2020-06-29 - ! ORBEL_EHYBRID.F + ! swiftest_orbel_EHYBRID.F !********************************************************************** ! PURPOSE: Solves Kepler's eqn. e is ecc. m is mean anomaly. ! @@ -623,7 +621,7 @@ end function orbel_eget ! e ==> eccentricity anomaly. (real scalar) ! m ==> mean anomaly. (real scalar) ! Returns: - ! orbel_ehybrid ==> eccentric anomaly. (real scalar) + ! swiftest_orbel_ehybrid ==> eccentric anomaly. (real scalar) ! ! ALGORITHM: For e < 0.18 uses fast routine ESOLMD ! For larger e but less than 0.8, uses EGET @@ -633,28 +631,28 @@ end function orbel_eget ! DATE WRITTEN: May 25,1992. ! REVISIONS: 2/26/93 hfl !********************************************************************** - real(DP) pure function orbel_ehybrid(e,m) + real(DP) pure function swiftest_orbel_ehybrid(e,m) implicit none real(DP), intent(in) :: e,m - !real(DP) :: orbel_esolmd,orbel_eget,orbel_ehie + !real(DP) :: swiftest_orbel_esolmd,orbel_eget,orbel_ehie if (e < 0.18_DP) then - orbel_ehybrid = orbel_esolmd(e,m) + swiftest_orbel_ehybrid = swiftest_orbel_esolmd(e,m) else if( e <= 0.8_DP) then - orbel_ehybrid = orbel_eget(e,m) + swiftest_orbel_ehybrid = swiftest_orbel_eget(e,m) else - orbel_ehybrid = orbel_ehie(e,m) + swiftest_orbel_ehybrid = swiftest_orbel_ehie(e,m) end if end if return - end function orbel_ehybrid + end function swiftest_orbel_ehybrid !********************************************************************** ! Code converted to Modern Fortran by David A. Minton ! Date: 2020-06-29 - ! ORBEL_FHYBRID.F + ! swiftest_orbel_FHYBRID.F !********************************************************************** ! PURPOSE: Solves Kepler's eqn. for hyperbola using hybrid approach. ! @@ -662,7 +660,7 @@ end function orbel_ehybrid ! e ==> eccentricity anomaly. (real scalar) ! n ==> hyperbola mean anomaly. (real scalar) ! Returns: - ! orbel_fhybrid ==> eccentric anomaly. (real scalar) + ! swiftest_orbel_fhybrid ==> eccentric anomaly. (real scalar) ! ! ALGORITHM: For abs(N) < 0.636*ecc -0.6 , use FLON ! For larger N, uses FGET @@ -672,7 +670,7 @@ end function orbel_ehybrid ! REVISIONS:: ! REVISIONS: 2/26/93 hfl !********************************************************************** - real(DP) pure function orbel_fhybrid(e,n) + real(DP) pure function swiftest_orbel_fhybrid(e,n) implicit none real(DP), intent(in) :: e,n @@ -682,16 +680,16 @@ real(DP) pure function orbel_fhybrid(e,n) if(n < 0._DP) abn = -abn if(abn < 0.636_DP * e -0.6_DP) then - orbel_fhybrid = orbel_flon(e,n) + swiftest_orbel_fhybrid = swiftest_orbel_flon(e,n) else - orbel_fhybrid = orbel_fget(e,n) + swiftest_orbel_fhybrid = swiftest_orbel_fget(e,n) end if return - end function orbel_fhybrid + end function swiftest_orbel_fhybrid - pure module subroutine orbel_xv2aeq(mu, px, py, pz, vx, vy, vz, a, e, q) + pure elemental module subroutine swiftest_orbel_xv2aeq(mu, px, py, pz, vx, vy, vz, a, e, q) !! author: David A. Minton !! !! Compute semimajor axis, eccentricity, and pericentric distance from relative Cartesian position and velocity @@ -753,10 +751,10 @@ pure module subroutine orbel_xv2aeq(mu, px, py, pz, vx, vy, vz, a, e, q) return - end subroutine orbel_xv2aeq + end subroutine swiftest_orbel_xv2aeq - pure module subroutine orbel_xv2aqt(mu, px, py, pz, vx, vy, vz, a, q, capm, tperi) + pure module subroutine swiftest_orbel_xv2aqt(mu, px, py, pz, vx, vy, vz, a, q, capm, tperi) !! author: David A. Minton !! !! Compute semimajor axis, pericentric distance, mean anomaly, and time to nearest pericenter passage from @@ -862,10 +860,10 @@ pure module subroutine orbel_xv2aqt(mu, px, py, pz, vx, vy, vz, a, q, capm, tper return - end subroutine orbel_xv2aqt + end subroutine swiftest_orbel_xv2aqt - module subroutine orbel_xv2el_vec(self, cb) + module subroutine swiftest_orbel_xv2el_vec(self, cb) !! author: David A. Minton !! !! A wrapper method that converts all of the cartesian position and velocity vectors of a Swiftest body object to orbital elements. @@ -875,6 +873,7 @@ module subroutine orbel_xv2el_vec(self, cb) class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object ! internals integer(I4B) :: i + real(DP) :: varpi, lam, f, cape, capf if (self%nbody == 0) return @@ -886,17 +885,18 @@ module subroutine orbel_xv2el_vec(self, cb) if (allocated(self%omega)) deallocate(self%omega); allocate(self%omega(self%nbody)) if (allocated(self%capm)) deallocate(self%capm); allocate(self%capm(self%nbody)) do concurrent (i = 1:self%nbody) - call orbel_xv2el(self%mu(i), self%xh(1,i), self%xh(2,i), self%xh(3,i), & + call swiftest_orbel_xv2el(self%mu(i), self%rh(1,i), self%rh(2,i), self%rh(3,i), & self%vh(1,i), self%vh(2,i), self%vh(3,i), & - self%a(i), self%e(i), self%inc(i), & - self%capom(i), self%omega(i), self%capm(i)) + self%a(i), self%e(i), self%inc(i), & + self%capom(i), self%omega(i), self%capm(i), & + varpi, lam, f, cape, capf) end do return - end subroutine orbel_xv2el_vec + end subroutine swiftest_orbel_xv2el_vec - pure module subroutine orbel_xv2el(mu, px, py, pz, vx, vy, vz, a, e, inc, capom, omega, capm) + pure module subroutine swiftest_orbel_xv2el(mu, px, py, pz, vx, vy, vz, a, e, inc, capom, omega, capm, varpi, lam, f, cape, capf) !! author: David A. Minton !! !! Compute osculating orbital elements from relative Cartesian position and velocity @@ -922,9 +922,14 @@ pure module subroutine orbel_xv2el(mu, px, py, pz, vx, vy, vz, a, e, inc, capom, 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) ! Internals integer(I4B) :: iorbit_type - real(DP) :: r, v2, h2, h, rdotv, energy, fac, u, w, cw, sw, face, cape, tmpf, capf + real(DP) :: r, v2, h2, h, rdotv, energy, fac, u, w, cw, sw, face, tmpf, sf, cf, rdot real(DP), dimension(NDIM) :: hvec, x, v a = 0.0_DP @@ -1024,9 +1029,21 @@ pure module subroutine orbel_xv2el(mu, px, py, pz, vx, vy, vz, a, e, inc, capom, end select omega = u - w if (omega < 0.0_DP) omega = omega + TWOPI + varpi = mod(omega + capom, TWOPI) + lam = mod(capm + varpi, TWOPI) + if (e > VSMALL) then + cf = 1.0_DP / e * (a * (1.0_DP - e**2)/r - 1.0_DP) + rdot = sign(sqrt(v2 - (h / r)**2),rdotv) + sf = a * (1.0_DP - e**2) / (h * e) * rdot + f = atan2(sf,cf) + if (f < 0.0_DP) f = f + TWOPI + else + f = u + end if + return - end subroutine orbel_xv2el + end subroutine swiftest_orbel_xv2el -end submodule s_orbel +end submodule s_swiftest_orbel diff --git a/src/user/user_getacch.f90 b/src/swiftest/swiftest_user.f90 similarity index 82% rename from src/user/user_getacch.f90 rename to src/swiftest/swiftest_user.f90 index 0ba61bd8d..805a500ef 100644 --- a/src/user/user_getacch.f90 +++ b/src/swiftest/swiftest_user.f90 @@ -7,10 +7,10 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(swiftest_classes) s_user_kick_getacch +submodule(swiftest) s_swiftest_user use swiftest contains - module subroutine user_kick_getacch_body(self, system, param, t, lbeg) + module subroutine swiftest_user_kick_getacch_body(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Add user-supplied heliocentric accelerations to planets. @@ -19,12 +19,12 @@ module subroutine user_kick_getacch_body(self, system, param, t, lbeg) implicit none ! Arguments class(swiftest_body), intent(inout) :: self !! Swiftest massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody_system_object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody_system_object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters user parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the ste return - end subroutine user_kick_getacch_body + end subroutine swiftest_user_kick_getacch_body -end submodule s_user_kick_getacch +end submodule s_swiftest_user diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 new file mode 100644 index 000000000..73b4ef5b6 --- /dev/null +++ b/src/swiftest/swiftest_util.f90 @@ -0,0 +1,4600 @@ +!! 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. + +submodule (swiftest) s_swiftest_util + use whm + use rmvs + use helio + use symba + use fraggle +contains + + module subroutine swiftest_util_append_arr_char_string(arr, source, nold, nsrc, 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. + 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) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + ! Internals + integer(I4B) :: nnew + + if (.not. allocated(source)) return + + nnew = count(lsource_mask(1:nsrc)) + if (.not.allocated(arr)) then + allocate(arr(nold+nnew)) + else + call swiftest_util_resize(arr, nold + nnew) + end if + + arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) + + return + end subroutine swiftest_util_append_arr_char_string + + + module subroutine swiftest_util_append_arr_DP(arr, source, nold, nsrc, 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. + 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) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + ! Internals + integer(I4B) :: nnew + + if (.not. allocated(source)) return + + nnew = count(lsource_mask(1:nsrc)) + if (.not.allocated(arr)) then + allocate(arr(nold+nnew)) + else + call swiftest_util_resize(arr, nold + nnew) + end if + + arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) + + return + end subroutine swiftest_util_append_arr_DP + + + module subroutine swiftest_util_append_arr_DPvec(arr, source, nold, nsrc, 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. + 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) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + ! Internals + integer(I4B) :: nnew + + if (.not. allocated(source)) return + + nnew = count(lsource_mask(1:nsrc)) + if (.not.allocated(arr)) then + allocate(arr(NDIM,nold+nnew)) + else + call swiftest_util_resize(arr, nold + nnew) + end if + + arr(1, nold + 1:nold + nnew) = pack(source(1,1:nsrc), lsource_mask(1:nsrc)) + arr(2, nold + 1:nold + nnew) = pack(source(2,1:nsrc), lsource_mask(1:nsrc)) + arr(3, nold + 1:nold + nnew) = pack(source(3,1:nsrc), lsource_mask(1:nsrc)) + + return + end subroutine swiftest_util_append_arr_DPvec + + + module subroutine swiftest_util_append_arr_I4B(arr, source, nold, nsrc, 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. + 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) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + ! Internals + integer(I4B) :: nnew + + if (.not. allocated(source)) return + + nnew = count(lsource_mask(1:nsrc)) + if (.not.allocated(arr)) then + allocate(arr(nold+nnew)) + else + call swiftest_util_resize(arr, nold + nnew) + end if + + arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) + + return + end subroutine swiftest_util_append_arr_I4B + + + module subroutine swiftest_util_append_arr_info(arr, source, nold, nsrc, lsource_mask) + !! author: David A. Minton + !! + !! Append a single array of particle information type onto another. If the destination array is not allocated, or is not big enough, this will allocate space for it. + implicit none + ! Arguments + 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) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + ! Internals + integer(I4B) :: nnew, i + integer(I4B), dimension(:), allocatable :: idx + + if (.not. allocated(source)) return + + nnew = count(lsource_mask(1:nsrc)) + if (.not.allocated(arr)) then + allocate(arr(nold+nnew)) + else + call swiftest_util_resize(arr, nold + nnew) + end if + + allocate(idx(nnew)) + + idx = pack([(i, i = 1, nsrc)], lsource_mask(1:nsrc)) + + call swiftest_util_copy_particle_info_arr(source(1:nsrc), arr(nold+1:nold+nnew), idx) + + return + end subroutine swiftest_util_append_arr_info + + + module subroutine swiftest_util_append_arr_kin(arr, source, nold, nsrc, lsource_mask) + !! author: David A. Minton + !! + !! Append a single array of kinship type onto another. If the destination array is not allocated, or is not big enough, this will allocate space for it. + implicit none + ! Arguments + 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) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + ! Internals + integer(I4B) :: nnew + + if (.not. allocated(source)) return + + nnew = count(lsource_mask(1:nsrc)) + if (.not.allocated(arr)) then + allocate(arr(nold+nnew)) + else + call swiftest_util_resize(arr, nold + nnew) + end if + + arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) + + return + end subroutine swiftest_util_append_arr_kin + + + module subroutine swiftest_util_append_arr_logical(arr, source, nold, nsrc, 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. + implicit none + ! Arguments + logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array + logical, dimension(:), allocatable, intent(in) :: source !! Array to append + integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + ! Internals + integer(I4B) :: nnew + + if (.not. allocated(source)) return + + nnew = count(lsource_mask(1:nsrc)) + if (.not.allocated(arr)) then + allocate(arr(nold+nnew)) + else + call swiftest_util_resize(arr, nold + nnew) + end if + + arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) + + return + end subroutine swiftest_util_append_arr_logical + + + module subroutine swiftest_util_append_body(self, source, lsource_mask) + !! author: David A. Minton + !! + !! Append components from one Swiftest body object to another. + !! This method will automatically resize the destination body if it is too small + implicit none + ! Arguments + 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 + ! Internals + integer(I4B) :: nold, nsrc, nnew + + nold = self%nbody + nsrc = source%nbody + nnew = count(lsource_mask(1:nsrc)) + + call swiftest_util_append(self%id, source%id, nold, nsrc, lsource_mask) + call swiftest_util_append(self%info, source%info, nold, nsrc, lsource_mask) + call swiftest_util_append(self%lmask, source%lmask, nold, nsrc, lsource_mask) + call swiftest_util_append(self%status, source%status, nold, nsrc, lsource_mask) + call swiftest_util_append(self%ldiscard, source%ldiscard, nold, nsrc, lsource_mask) + call swiftest_util_append(self%lencounter, source%lencounter, nold, nsrc, lsource_mask) + call swiftest_util_append(self%lcollision, source%lcollision, nold, nsrc, lsource_mask) + call swiftest_util_append(self%mu, source%mu, nold, nsrc, lsource_mask) + call swiftest_util_append(self%rh, source%rh, nold, nsrc, lsource_mask) + call swiftest_util_append(self%vh, source%vh, nold, nsrc, lsource_mask) + call swiftest_util_append(self%rb, source%rb, nold, nsrc, lsource_mask) + call swiftest_util_append(self%vb, source%vb, nold, nsrc, lsource_mask) + call swiftest_util_append(self%ah, source%ah, nold, nsrc, lsource_mask) + call swiftest_util_append(self%aobl, source%aobl, nold, nsrc, lsource_mask) + call swiftest_util_append(self%atide, source%atide, nold, nsrc, lsource_mask) + call swiftest_util_append(self%agr, source%agr, nold, nsrc, lsource_mask) + call swiftest_util_append(self%ir3h, source%ir3h, nold, nsrc, lsource_mask) + call swiftest_util_append(self%isperi, source%isperi, nold, nsrc, lsource_mask) + call swiftest_util_append(self%peri, source%peri, nold, nsrc, lsource_mask) + call swiftest_util_append(self%atp, source%atp, nold, nsrc, lsource_mask) + call swiftest_util_append(self%a, source%a, nold, nsrc, lsource_mask) + call swiftest_util_append(self%e, source%e, nold, nsrc, lsource_mask) + call swiftest_util_append(self%inc, source%inc, nold, nsrc, lsource_mask) + call swiftest_util_append(self%capom, source%capom, nold, nsrc, lsource_mask) + call swiftest_util_append(self%omega, source%omega, nold, nsrc, lsource_mask) + call swiftest_util_append(self%capm, source%capm, nold, nsrc, lsource_mask) + + self%nbody = nold + nnew + + return + end subroutine swiftest_util_append_body + + + module subroutine swiftest_util_append_pl(self, source, lsource_mask) + !! author: David A. Minton + !! + !! Append components from one Swiftest body object to another. + !! This method will automatically resize the destination body if it is too small + implicit none + ! Arguments + 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 + + select type(source) + class is (swiftest_pl) + associate(nold => self%nbody, nsrc => source%nbody) + call swiftest_util_append(self%mass, source%mass, nold, nsrc, lsource_mask) + call swiftest_util_append(self%Gmass, source%Gmass, nold, nsrc, lsource_mask) + call swiftest_util_append(self%rhill, source%rhill, nold, nsrc, lsource_mask) + call swiftest_util_append(self%renc, source%renc, nold, nsrc, lsource_mask) + call swiftest_util_append(self%radius, source%radius, nold, nsrc, lsource_mask) + call swiftest_util_append(self%density, source%density, nold, nsrc, lsource_mask) + call swiftest_util_append(self%rbeg, source%rbeg, nold, nsrc, lsource_mask) + call swiftest_util_append(self%rend, source%rend, nold, nsrc, lsource_mask) + call swiftest_util_append(self%vbeg, source%vbeg, nold, nsrc, lsource_mask) + call swiftest_util_append(self%Ip, source%Ip, nold, nsrc, lsource_mask) + call swiftest_util_append(self%rot, source%rot, nold, nsrc, lsource_mask) + call swiftest_util_append(self%k2, source%k2, nold, nsrc, lsource_mask) + call swiftest_util_append(self%Q, source%Q, nold, nsrc, lsource_mask) + call swiftest_util_append(self%tlag, source%tlag, nold, nsrc, lsource_mask) + call swiftest_util_append(self%kin, source%kin, nold, nsrc, lsource_mask) + call swiftest_util_append(self%lmtiny, source%lmtiny, nold, nsrc, lsource_mask) + call swiftest_util_append(self%nplenc, source%nplenc, nold, nsrc, lsource_mask) + call swiftest_util_append(self%ntpenc, source%ntpenc, nold, nsrc, lsource_mask) + + if (allocated(self%k_plpl)) deallocate(self%k_plpl) + + call swiftest_util_append_body(self, source, lsource_mask) + end associate + class default + write(*,*) "Invalid object passed to the append method. Source must be of class swiftest_pl or its descendents" + call util_exit(FAILURE) + end select + + return + end subroutine swiftest_util_append_pl + + + module subroutine swiftest_util_append_tp(self, source, lsource_mask) + !! author: David A. Minton + !! + !! Append components from one Swiftest body object to another. + !! This method will automatically resize the destination body if it is too small + implicit none + ! Arguments + 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 + + select type(source) + class is (swiftest_tp) + associate(nold => self%nbody, nsrc => source%nbody) + call swiftest_util_append(self%nplenc, source%nplenc, nold, nsrc, lsource_mask) + + call swiftest_util_append_body(self, source, lsource_mask) + end associate + class default + write(*,*) "Invalid object passed to the append method. Source must be of class swiftest_tp or its descendents" + call util_exit(FAILURE) + end select + + return + end subroutine swiftest_util_append_tp + + + module subroutine swiftest_util_coord_h2b_pl(self, cb) + !! author: David A. Minton + !! + !! Convert massive bodies from heliocentric to barycentric coordinates (position and velocity) + !! + !! Adapted from David E. Kaufmann's Swifter routine coord_h2b.f90 + !! Adapted from Hal Levison's Swift routine coord_h2b.f + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + ! Internals + integer(I4B) :: i + real(DP) :: Gmtot + real(DP), dimension(NDIM) :: xtmp, vtmp + + if (self%nbody == 0) return + associate(pl => self, npl => self%nbody) + Gmtot = cb%Gmass + xtmp(:) = 0.0_DP + vtmp(:) = 0.0_DP + do i = 1, npl + if (pl%status(i) == INACTIVE) cycle + Gmtot = Gmtot + pl%Gmass(i) + xtmp(:) = xtmp(:) + pl%Gmass(i) * pl%rh(:,i) + vtmp(:) = vtmp(:) + pl%Gmass(i) * pl%vh(:,i) + end do + cb%rb(:) = -xtmp(:) / Gmtot + cb%vb(:) = -vtmp(:) / Gmtot + do i = 1, npl + if (pl%status(i) == INACTIVE) cycle + pl%rb(:,i) = pl%rh(:,i) + cb%rb(:) + pl%vb(:,i) = pl%vh(:,i) + cb%vb(:) + end do + end associate + + return + end subroutine swiftest_util_coord_h2b_pl + + + module subroutine swiftest_util_coord_h2b_tp(self, cb) + !! author: David A. Minton + !! + !! Convert test particles from heliocentric to barycentric coordinates (position and velocity) + !! + !! Adapted from David E. Kaufmann's Swifter routine coord_h2b_tp.f90 + !! Adapted from Hal Levison's Swift routine coord_h2b_tp.f + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_cb), intent(in) :: cb !! Swiftest central body object + ! Internals + integer(I4B) :: i + + if (self%nbody == 0) return + associate(tp => self, ntp => self%nbody) + do concurrent (i = 1:ntp, tp%status(i) /= INACTIVE) + tp%rb(:, i) = tp%rh(:, i) + cb%rb(:) + tp%vb(:, i) = tp%vh(:, i) + cb%vb(:) + end do + end associate + + return + end subroutine swiftest_util_coord_h2b_tp + + + module subroutine swiftest_util_coord_b2h_pl(self, cb) + !! author: David A. Minton + !! + !! Convert massive bodies from barycentric to heliocentric coordinates (position and velocity) + !! + !! Adapted from David E. Kaufmann's Swifter routine coord_b2h.f90 + !! Adapted from Hal Levison's Swift routine coord_b2h.f + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + ! Internals + integer(I4B) :: i + + if (self%nbody == 0) return + + associate(pl => self, npl => self%nbody) + do concurrent (i = 1:npl, pl%status(i) /= INACTIVE) + pl%rh(:, i) = pl%rb(:, i) - cb%rb(:) + pl%vh(:, i) = pl%vb(:, i) - cb%vb(:) + end do + end associate + + return + end subroutine swiftest_util_coord_b2h_pl + + + module subroutine swiftest_util_coord_b2h_tp(self, cb) + !! author: David A. Minton + !! + !! Convert test particles from barycentric to heliocentric coordinates (position and velocity) + !! + !! Adapted from David E. Kaufmann's Swifter routine coord_b2h_tp.f90 + !! Adapted from Hal Levison's Swift routine coord_b2h_tp.f + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(in) :: cb !! Swiftest central body object + ! Internals + integer(I4B) :: i + + if (self%nbody == 0) return + + associate(tp => self, ntp => self%nbody) + do concurrent(i = 1:ntp, tp%status(i) /= INACTIVE) + tp%rh(:, i) = tp%rb(:, i) - cb%rb(:) + tp%vh(:, i) = tp%vb(:, i) - cb%vb(:) + end do + end associate + + return + end subroutine swiftest_util_coord_b2h_tp + + + module subroutine swiftest_util_coord_vb2vh_pl(self, cb) + !! author: David A. Minton + !! + !! Convert massive bodies from barycentric to heliocentric coordinates (velocity only) + !! + !! Adapted from David E. Kaufmann's Swifter routine coord_vb2vh.f90 + !! Adapted from Hal Levison's Swift routine coord_vb2vh.f + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + ! Internals + integer(I4B) :: i + + if (self%nbody == 0) return + + associate(pl => self, npl => self%nbody) + cb%vb(:) = 0.0_DP + do i = npl, 1, -1 + cb%vb(:) = cb%vb(:) - pl%Gmass(i) * pl%vb(:, i) / cb%Gmass + end do + do concurrent(i = 1:npl) + pl%vh(:, i) = pl%vb(:, i) - cb%vb(:) + end do + end associate + + return + end subroutine swiftest_util_coord_vb2vh_pl + + + module subroutine swiftest_util_coord_vb2vh_tp(self, vbcb) + !! author: David A. Minton + !! + !! Convert test particles from barycentric to heliocentric coordinates (velocity only) + !! + !! Adapted from David E. Kaufmann's Swifter routine coord_vb2vh_tp.f90 + !! Adapted from Hal Levison's Swift routine coord_vb2h_tp.f + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + real(DP), dimension(:), intent(in) :: vbcb !! Barycentric velocity of the central body + + if (self%nbody == 0) return + + associate(tp => self, ntp => self%nbody) + where (tp%lmask(1:ntp)) + tp%vh(1, 1:ntp) = tp%vb(1, 1:ntp) - vbcb(1) + tp%vh(2, 1:ntp) = tp%vb(2, 1:ntp) - vbcb(2) + tp%vh(3, 1:ntp) = tp%vb(3, 1:ntp) - vbcb(3) + end where + end associate + + return + end subroutine swiftest_util_coord_vb2vh_tp + + + module subroutine swiftest_util_coord_vh2vb_pl(self, cb) + !! author: David A. Minton + !! + !! Convert massive bodies from heliocentric to barycentric coordinates (velocity only) + !! + !! Adapted from David E. Kaufmann's Swifter routine coord_vh2vb.f90 + !! Adapted from Hal Levison's Swift routine coord_vh2b.f + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + ! Internals + integer(I4B) :: i + real(DP) :: Gmtot + + if (self%nbody == 0) return + + associate(pl => self, npl => self%nbody) + Gmtot = cb%Gmass + sum(pl%Gmass(1:npl)) + cb%vb(:) = 0.0_DP + do i = 1, npl + cb%vb(:) = cb%vb(:) - pl%Gmass(i) * pl%vh(:, i) + end do + cb%vb(:) = cb%vb(:) / Gmtot + do concurrent(i = 1:npl) + pl%vb(:, i) = pl%vh(:, i) + cb%vb(:) + end do + end associate + + return + end subroutine swiftest_util_coord_vh2vb_pl + + + module subroutine swiftest_util_coord_vh2vb_tp(self, vbcb) + !! author: David A. Minton + !! + !! Convert test particles from heliocentric to barycentric coordinates (velocity only) + !! + !! Adapted from David E. Kaufmann's Swifter routine coord_vh2vb_tp.f90 + !! Adapted from Hal Levison's Swift routine coord_vh2b_tp.f + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + real(DP), dimension(:), intent(in) :: vbcb !! Barycentric velocity of the central body + + if (self%nbody == 0) return + + associate(tp => self, ntp => self%nbody) + where (tp%lmask(1:ntp)) + tp%vb(1, 1:ntp) = tp%vh(1, 1:ntp) + vbcb(1) + tp%vb(2, 1:ntp) = tp%vh(2, 1:ntp) + vbcb(2) + tp%vb(3, 1:ntp) = tp%vh(3, 1:ntp) + vbcb(3) + end where + end associate + + return + end subroutine swiftest_util_coord_vh2vb_tp + + + module subroutine swiftest_util_coord_rh2rb_pl(self, cb) + !! author: David A. Minton + !! + !! Convert position vectors of massive bodies from heliocentric to barycentric coordinates (position only) + !! + !! Adapted from David E. Kaufmann's Swifter routine coord_h2b.f90 + !! Adapted from Hal Levison's Swift routine coord_h2b.f + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + ! Internals + integer(I4B) :: i + real(DP) :: Gmtot + real(DP), dimension(NDIM) :: xtmp + + if (self%nbody == 0) return + associate(pl => self, npl => self%nbody) + Gmtot = cb%Gmass + xtmp(:) = 0.0_DP + do i = 1, npl + if (pl%status(i) == INACTIVE) cycle + Gmtot = Gmtot + pl%Gmass(i) + xtmp(:) = xtmp(:) + pl%Gmass(i) * pl%rh(:,i) + end do + cb%rb(:) = -xtmp(:) / Gmtot + do i = 1, npl + if (pl%status(i) == INACTIVE) cycle + pl%rb(:,i) = pl%rh(:,i) + cb%rb(:) + end do + end associate + + return + end subroutine swiftest_util_coord_rh2rb_pl + + + module subroutine swiftest_util_coord_rh2rb_tp(self, cb) + !! author: David A. Minton + !! + !! Convert test particles from heliocentric to barycentric coordinates (position only) + !! + !! Adapted from David E. Kaufmann's Swifter routine coord_h2b_tp.f90 + !! Adapted from Hal Levison's Swift routine coord_h2b_tp.f + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_cb), intent(in) :: cb !! Swiftest central body object + ! Internals + integer(I4B) :: i + + if (self%nbody == 0) return + associate(tp => self, ntp => self%nbody) + do concurrent (i = 1:ntp, tp%status(i) /= INACTIVE) + tp%rb(:, i) = tp%rh(:, i) + cb%rb(:) + end do + end associate + + return + end subroutine swiftest_util_coord_rh2rb_tp + + + module subroutine swiftest_util_copy_particle_info(self, source) + !! author: David A. Minton + !! + !! Copies one set of information object components into another, component-by-component + implicit none + class(swiftest_particle_info), intent(inout) :: self + class(swiftest_particle_info), intent(in) :: source + + call self%set_value(& + name = source%name, & + particle_type = source%particle_type, & + status = source%status, & + origin_type = source%origin_type, & + origin_time = source%origin_time, & + collision_id = source%collision_id, & + origin_rh = source%origin_rh(:), & + origin_vh = source%origin_vh(:), & + discard_time = source%discard_time, & + discard_rh = source%discard_rh(:), & + discard_vh = source%discard_vh(:), & + discard_body_id = source%discard_body_id & + ) + + return + end subroutine swiftest_util_copy_particle_info + + + module subroutine swiftest_util_copy_particle_info_arr(source, dest, idx) + !! author: David A. Minton + !! + !! Copies contents from an array of one particle information objects to another. + 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 + ! Internals + integer(I4B) :: i, j, n, nsource, ndest + + if (size(source) == 0) return + + if (present(idx)) then + n = size(idx) + else + n = size(source) + end if + + nsource = size(source) + ndest = size(dest) + + if ((n == 0) .or. (n > ndest) .or. (n > nsource)) then + write(*,*) 'Particle info copy operation failed. n, nsource, ndest: ',n, nsource, ndest + return + end if + + do i = 1, n + if (present(idx)) then + j = idx(i) + else + j = i + end if + call dest(i)%copy(source(j)) + end do + + return + end subroutine swiftest_util_copy_particle_info_arr + + + module subroutine swiftest_util_dealloc_body(self) + !! author: David A. Minton + !! + !! Finalize the swiftest body object - deallocates all allocatables + implicit none + ! Argument + class(swiftest_body), intent(inout) :: self + + if (allocated(self%info)) deallocate(self%info) + if (allocated(self%id)) deallocate(self%id) + if (allocated(self%status)) deallocate(self%status) + if (allocated(self%ldiscard)) deallocate(self%ldiscard) + if (allocated(self%lcollision)) deallocate(self%lcollision) + if (allocated(self%lencounter)) deallocate(self%lencounter) + if (allocated(self%lmask)) deallocate(self%lmask) + if (allocated(self%mu)) deallocate(self%mu) + if (allocated(self%rh)) deallocate(self%rh) + if (allocated(self%vh)) deallocate(self%vh) + if (allocated(self%rb)) deallocate(self%rb) + if (allocated(self%vb)) deallocate(self%vb) + if (allocated(self%ah)) deallocate(self%ah) + if (allocated(self%aobl)) deallocate(self%aobl) + if (allocated(self%agr)) deallocate(self%agr) + if (allocated(self%atide)) deallocate(self%atide) + if (allocated(self%ir3h)) deallocate(self%ir3h) + if (allocated(self%a)) deallocate(self%a) + if (allocated(self%e)) deallocate(self%e) + if (allocated(self%e)) deallocate(self%e) + if (allocated(self%inc)) deallocate(self%inc) + if (allocated(self%capom)) deallocate(self%capom) + if (allocated(self%omega)) deallocate(self%omega) + if (allocated(self%capm)) deallocate(self%capm) + + return + end subroutine swiftest_util_dealloc_body + + + module subroutine swiftest_util_dealloc_kin(self) + !! author: David A. Minton + !! + !! Deallocates all allocatabale arrays + implicit none + ! Arguments + class(swiftest_kinship), intent(inout) :: self !! Swiftest kinship object + + if (allocated(self%child)) deallocate(self%child) + + return + end subroutine swiftest_util_dealloc_kin + + + module subroutine swiftest_util_dealloc_pl(self) + !! author: David A. Minton + !! + !! Finalize the swiftest massive body object - deallocates all allocatables + implicit none + ! Argument + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + ! Internals + integer(I4B) :: i + + if (allocated(self%mass)) deallocate(self%mass) + if (allocated(self%Gmass)) deallocate(self%Gmass) + if (allocated(self%rhill)) deallocate(self%rhill) + if (allocated(self%renc)) deallocate(self%renc) + if (allocated(self%radius)) deallocate(self%radius) + if (allocated(self%density)) deallocate(self%density) + if (allocated(self%rot)) deallocate(self%rot) + if (allocated(self%Ip)) deallocate(self%Ip) + if (allocated(self%k2)) deallocate(self%k2) + if (allocated(self%Q)) deallocate(self%Q) + if (allocated(self%tlag)) deallocate(self%tlag) + if (allocated(self%k_plpl)) deallocate(self%k_plpl) + if (allocated(self%lmtiny)) deallocate(self%lmtiny) + if (allocated(self%nplenc)) deallocate(self%nplenc) + if (allocated(self%ntpenc)) deallocate(self%ntpenc) + + + if (allocated(self%kin)) then + do i = 1, self%nbody + call self%kin(i)%dealloc() + end do + deallocate(self%kin) + end if + + call swiftest_util_dealloc_body(self) + + return + end subroutine swiftest_util_dealloc_pl + + + module subroutine swiftest_util_dealloc_tp(self) + !! author: David A. Minton + !! + !! Finalize the swiftest test particle object - deallocates all allocatables + implicit none + ! Argument + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + + if (allocated(self%nplenc)) deallocate(self%nplenc) + if (allocated(self%k_pltp)) deallocate(self%k_pltp) + + call swiftest_util_dealloc_body(self) + + return + end subroutine swiftest_util_dealloc_tp + + + module subroutine swiftest_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 + 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 + + if (.not.allocated(keeps) .or. .not.allocated(inserts)) return + + keeps(:) = unpack(keeps(:), .not.lfill_list(:), keeps(:)) + keeps(:) = unpack(inserts(:), lfill_list(:), keeps(:)) + + return + end subroutine swiftest_util_fill_arr_char_string + + + module subroutine swiftest_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 + 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 + + if (.not.allocated(keeps) .or. .not.allocated(inserts)) return + + keeps(:) = unpack(keeps(:), .not.lfill_list(:), keeps(:)) + keeps(:) = unpack(inserts(:), lfill_list(:), keeps(:)) + + return + end subroutine swiftest_util_fill_arr_DP + + + module subroutine swiftest_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 + 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 + ! Internals + integer(I4B) :: i + + if (.not.allocated(keeps) .or. .not.allocated(inserts)) return + + do i = 1, NDIM + keeps(i,:) = unpack(keeps(i,:), .not.lfill_list(:), keeps(i,:)) + keeps(i,:) = unpack(inserts(i,:), lfill_list(:), keeps(i,:)) + end do + + return + end subroutine swiftest_util_fill_arr_DPvec + + + module subroutine swiftest_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 + 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 + + if (.not.allocated(keeps) .or. .not.allocated(inserts)) return + + keeps(:) = unpack(keeps(:), .not.lfill_list(:), keeps(:)) + keeps(:) = unpack(inserts(:), lfill_list(:), keeps(:)) + + return + end subroutine swiftest_util_fill_arr_I4B + + + module subroutine swiftest_util_fill_arr_info(keeps, inserts, lfill_list) + !! author: David A. Minton + !! + !! Performs a fill operation on a single array of particle origin information types + !! This is the inverse of a spill operation + implicit none + ! Arguments + 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 + ! Internals + integer(I4B), dimension(:), allocatable :: insert_idx + integer(I4B) :: i, nkeep, ninsert + + if (.not.allocated(keeps) .or. .not.allocated(inserts)) return + + nkeep = size(keeps) + ninsert = count(lfill_list) + + allocate(insert_idx(ninsert)) + + insert_idx(:) = pack([(i, i = 1, nkeep)], lfill_list) + call swiftest_util_copy_particle_info_arr(inserts, keeps, insert_idx) + + return + end subroutine swiftest_util_fill_arr_info + + + module subroutine swiftest_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 + 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 + + if (.not.allocated(keeps) .or. .not.allocated(inserts)) return + + keeps(:) = unpack(keeps(:), .not.lfill_list(:), keeps(:)) + keeps(:) = unpack(inserts(:), lfill_list(:), keeps(:)) + + return + end subroutine swiftest_util_fill_arr_logical + + + module subroutine swiftest_util_fill_arr_kin(keeps, inserts, lfill_list) + !! author: David A. Minton + !! + !! Performs a fill operation on a single array of particle kinship types + !! This is the inverse of a spill operation + implicit none + ! Arguments + 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 + + if (.not.allocated(keeps) .or. .not.allocated(inserts)) return + + keeps(:) = unpack(keeps(:), .not.lfill_list(:), keeps(:)) + keeps(:) = unpack(inserts(:), lfill_list(:), keeps(:)) + + return + end subroutine swiftest_util_fill_arr_kin + + + module subroutine swiftest_util_fill_body(self, inserts, lfill_list) + !! author: David A. Minton + !! + !! Insert new Swiftest generic particle structure into an old one. + !! This is the inverse of a spill operation. + implicit none + ! Arguments + class(swiftest_body), intent(inout) :: self !! Swiftest generic 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 + + ! For each component, pack the discarded bodies into the discard object and do the inverse with the keeps + !> Fill all the common components + associate(keeps => self) + call swiftest_util_fill(keeps%id, inserts%id, lfill_list) + call swiftest_util_fill(keeps%info, inserts%info, lfill_list) + call swiftest_util_fill(keeps%lmask, inserts%lmask, lfill_list) + call swiftest_util_fill(keeps%status, inserts%status, lfill_list) + call swiftest_util_fill(keeps%ldiscard, inserts%ldiscard, lfill_list) + call swiftest_util_fill(keeps%lcollision, inserts%lcollision, lfill_list) + call swiftest_util_fill(keeps%lencounter, inserts%lencounter, lfill_list) + call swiftest_util_fill(keeps%mu, inserts%mu, lfill_list) + call swiftest_util_fill(keeps%rh, inserts%rh, lfill_list) + call swiftest_util_fill(keeps%vh, inserts%vh, lfill_list) + call swiftest_util_fill(keeps%rb, inserts%rb, lfill_list) + call swiftest_util_fill(keeps%vb, inserts%vb, lfill_list) + call swiftest_util_fill(keeps%ah, inserts%ah, lfill_list) + call swiftest_util_fill(keeps%aobl, inserts%aobl, lfill_list) + call swiftest_util_fill(keeps%agr, inserts%agr, lfill_list) + call swiftest_util_fill(keeps%atide, inserts%atide, lfill_list) + call swiftest_util_fill(keeps%ir3h, inserts%ir3h, lfill_list) + call swiftest_util_fill(keeps%isperi, inserts%isperi, lfill_list) + call swiftest_util_fill(keeps%peri, inserts%peri, lfill_list) + call swiftest_util_fill(keeps%atp, inserts%atp, lfill_list) + call swiftest_util_fill(keeps%a, inserts%a, lfill_list) + call swiftest_util_fill(keeps%e, inserts%e, lfill_list) + call swiftest_util_fill(keeps%inc, inserts%inc, lfill_list) + call swiftest_util_fill(keeps%capom, inserts%capom, lfill_list) + call swiftest_util_fill(keeps%omega, inserts%omega, lfill_list) + call swiftest_util_fill(keeps%capm, inserts%capm, lfill_list) + + ! This is the base class, so will be the last to be called in the cascade. + keeps%nbody = size(keeps%id(:)) + end associate + + return + end subroutine swiftest_util_fill_body + + + module subroutine swiftest_util_fill_pl(self, inserts, lfill_list) + !! author: David A. Minton + !! + !! Insert new Swiftest massive body structure into an old one. + !! This is the inverse of a spill operation. + implicit none + ! Arguments + 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 + + associate(keeps => self) + + select type (inserts) ! The standard requires us to select the type of both arguments in order to access all the components + class is (swiftest_pl) + !> Fill components specific to the massive body class + call swiftest_util_fill(keeps%mass, inserts%mass, lfill_list) + call swiftest_util_fill(keeps%Gmass, inserts%Gmass, lfill_list) + call swiftest_util_fill(keeps%rhill, inserts%rhill, lfill_list) + call swiftest_util_fill(keeps%renc, inserts%renc, lfill_list) + call swiftest_util_fill(keeps%radius, inserts%radius, lfill_list) + call swiftest_util_fill(keeps%density, inserts%density, lfill_list) + call swiftest_util_fill(keeps%rbeg, inserts%rbeg, lfill_list) + call swiftest_util_fill(keeps%rend, inserts%rend, lfill_list) + call swiftest_util_fill(keeps%vbeg, inserts%vbeg, lfill_list) + call swiftest_util_fill(keeps%Ip, inserts%Ip, lfill_list) + call swiftest_util_fill(keeps%rot, inserts%rot, lfill_list) + call swiftest_util_fill(keeps%k2, inserts%k2, lfill_list) + call swiftest_util_fill(keeps%Q, inserts%Q, lfill_list) + call swiftest_util_fill(keeps%tlag, inserts%tlag, lfill_list) + call swiftest_util_fill(keeps%kin, inserts%kin, lfill_list) + call swiftest_util_fill(keeps%nplenc, inserts%nplenc, lfill_list) + call swiftest_util_fill(keeps%ntpenc, inserts%ntpenc, lfill_list) + + if (allocated(keeps%k_plpl)) deallocate(keeps%k_plpl) + + call swiftest_util_fill_body(keeps, inserts, lfill_list) + class default + write(*,*) 'Error! fill method called for incompatible return type on swiftest_pl' + end select + end associate + + return + end subroutine swiftest_util_fill_pl + + + module subroutine swiftest_util_fill_tp(self, inserts, lfill_list) + !! author: David A. Minton + !! + !! Insert new Swiftest test particle structure into an old one. + !! This is the inverse of a fill operation. + implicit none + ! Arguments + 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 + + associate(keeps => self) + select type(inserts) + class is (swiftest_tp) + !> Spill components specific to the test particle class + call swiftest_util_fill(keeps%nplenc, inserts%nplenc, lfill_list) + + call swiftest_util_fill_body(keeps, inserts, lfill_list) + class default + write(*,*) 'Error! fill method called for incompatible return type on swiftest_tp' + end select + end associate + + return + end subroutine swiftest_util_fill_tp + + + pure module subroutine swiftest_util_flatten_eucl_ij_to_k(n, i, j, k) + !! author: Jacob R. Elliott and David A. Minton + !! + !! Turns i,j indices into k index for use in the Euclidean distance matrix for pl-pl interactions. + !! + !! Reference: + !! + !! Mélodie Angeletti, Jean-Marie Bonny, Jonas Koko. Parallel Euclidean distance matrix computation on big datasets *. + !! 2019. hal-0204751 + implicit none + ! Arguments + 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 + ! Internals + integer(I8B) :: i8, j8, n8 + + i8 = int(i, kind=I8B) + j8 = int(j, kind=I8B) + n8 = int(n, kind=I8B) + k = (i8 - 1_I8B) * n8 - i8 * (i8 - 1_I8B) / 2_I8B + (j8 - i8) + + return + end subroutine swiftest_util_flatten_eucl_ij_to_k + + + pure module subroutine swiftest_util_flatten_eucl_k_to_ij(n, k, i, j) + !! author: Jacob R. Elliott and David A. Minton + !! + !! Turns k index into i,j indices for use in the Euclidean distance matrix for pl-pl interactions. + !! + !! Reference: + !! + !! Mélodie Angeletti, Jean-Marie Bonny, Jonas Koko. Parallel Euclidean distance matrix computation on big datasets *. + !! 2019. hal-0204751 + implicit none + ! Arguments + 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 + ! Internals + integer(I8B) :: kp, p, i8, j8, n8 + + n8 = int(n, kind=I8B) + + kp = n8 * (n8 - 1_I8B) / 2_I8B - k + p = floor((sqrt(1._DP + 8_I8B * kp) - 1_I8B) / 2_I8B) + i8 = n8 - 1_I8B - p + j8 = k - (n8 - 1_I8B) * (n8 - 2_I8B) / 2_I8B + p * (p + 1_I8B) / 2_I8B + 1_I8B + + i = int(i8, kind=I4B) + j = int(j8, kind=I4B) + + return + end subroutine swiftest_util_flatten_eucl_k_to_ij + + + module subroutine swiftest_util_flatten_eucl_plpl(self, param) + !! author: Jacob R. Elliott and David A. Minton + !! + !! Turns i,j indices into k index for use in the Euclidean distance matrix for pl-pl interactions for a Swiftest massive body object + !! + !! Reference: + !! + !! Mélodie Angeletti, Jean-Marie Bonny, Jonas Koko. Parallel Euclidean distance matrix computation on big datasets *. + !! 2019. hal-0204751 + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i, j, err + integer(I8B) :: k, npl + + npl = int(self%nbody, kind=I8B) + associate(nplpl => self%nplpl) + nplpl = npl * (npl - 1_I8B) / 2_I8B ! number of entries in a strict lower triangle, npl x npl + if (param%lflatten_interactions) then + if (allocated(self%k_plpl)) deallocate(self%k_plpl) ! Reset the index array if it's been set previously + allocate(self%k_plpl(2, nplpl), stat=err) + if (err /=0) then ! An error occurred trying to allocate this big array. This probably means it's too big to fit in memory, and so we will force the run back into triangular mode + param%lflatten_interactions = .false. + else + do concurrent (i=1:npl, j=1:npl, j>i) + call swiftest_util_flatten_eucl_ij_to_k(self%nbody, i, j, k) + self%k_plpl(1, k) = i + self%k_plpl(2, k) = j + end do + end if + end if + end associate + + return + end subroutine swiftest_util_flatten_eucl_plpl + + + module subroutine swiftest_util_flatten_eucl_pltp(self, pl, param) + !! author: Jacob R. Elliott and David A. Minton + !! + !! Turns i,j indices into k index for use in the Euclidean distance matrix for pl-tp interactions + !! + !! Reference: + !! + !! Mélodie Angeletti, Jean-Marie Bonny, Jonas Koko. Parallel Euclidean distance matrix computation on big datasets *. + !! 2019. hal-0204751 + implicit none + ! Arguments + 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 + ! Internals + integer(I8B) :: i, j, counter, npl, ntp + + ntp = int(self%nbody, kind=I8B) + npl = int(pl%nbody, kind=I8B) + associate(npltp => self%npltp) + npltp = npl * ntp + if (allocated(self%k_pltp)) deallocate(self%k_pltp) ! Reset the index array if it's been set previously + allocate(self%k_pltp(2, npltp)) + do i = 1_I8B, npl + counter = (i - 1_I8B) * npl + 1_I8B + do j = 1_I8B, ntp + self%k_pltp(1, counter) = i + self%k_pltp(2, counter) = j + counter = counter + 1_I8B + end do + end do + end associate + + return + end subroutine swiftest_util_flatten_eucl_pltp + + + module subroutine swiftest_util_get_energy_momentum_system(self, param) + !! author: David A. Minton + !! + !! Compute total nbody_system angular momentum vector and kinetic, potential and total nbody_system energy + !! + !! Adapted from David E. Kaufmann Swifter routine symba_energy_eucl.f90 + !! + !! Adapted from Martin Duncan's Swift routine anal_energy.f + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i + real(DP) :: kecb, kespincb + real(DP), dimension(self%pl%nbody) :: kepl, kespinpl + real(DP), dimension(self%pl%nbody) :: Lplorbitx, Lplorbity, Lplorbitz + real(DP), dimension(self%pl%nbody) :: Lplspinx, Lplspiny, Lplspinz + real(DP), dimension(NDIM) :: Lcborbit, Lcbspin + real(DP) :: hx, hy, hz + + associate(nbody_system => self, pl => self%pl, npl => self%pl%nbody, cb => self%cb) + nbody_system%Lorbit(:) = 0.0_DP + nbody_system%Lspin(:) = 0.0_DP + nbody_system%Ltot(:) = 0.0_DP + nbody_system%ke_orbit = 0.0_DP + nbody_system%ke_spin = 0.0_DP + + kepl(:) = 0.0_DP + Lplorbitx(:) = 0.0_DP + Lplorbity(:) = 0.0_DP + Lplorbitz(:) = 0.0_DP + Lplspinx(:) = 0.0_DP + Lplspiny(:) = 0.0_DP + Lplspinz(:) = 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)) + kecb = cb%mass * dot_product(cb%vb(:), cb%vb(:)) + Lcborbit(:) = cb%mass * (cb%rb(:) .cross. cb%vb(:)) + + do concurrent (i = 1:npl, pl%lmask(i)) + hx = pl%rb(2,i) * pl%vb(3,i) - pl%rb(3,i) * pl%vb(2,i) + hy = pl%rb(3,i) * pl%vb(1,i) - pl%rb(1,i) * pl%vb(3,i) + hz = pl%rb(1,i) * pl%vb(2,i) - pl%rb(2,i) * pl%vb(1,i) + + ! Angular momentum from orbit + Lplorbitx(i) = pl%mass(i) * hx + Lplorbity(i) = pl%mass(i) * hy + Lplorbitz(i) = pl%mass(i) * hz + + ! Kinetic energy from orbit + kepl(i) = pl%mass(i) * dot_product(pl%vb(:,i), pl%vb(:,i)) + end do + + if (param%lrotation) then + kespincb = cb%mass * cb%Ip(3) * cb%radius**2 * dot_product(cb%rot(:), cb%rot(:)) + + ! 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(:) + + do concurrent (i = 1:npl, pl%lmask(i)) + ! Currently we assume that the rotation pole is the 3rd principal axis + ! Angular momentum from spin + Lplspinx(i) = pl%mass(i) * pl%Ip(3,i) * pl%radius(i)**2 * pl%rot(1,i) + Lplspiny(i) = pl%mass(i) * pl%Ip(3,i) * pl%radius(i)**2 * pl%rot(2,i) + Lplspinz(i) = pl%mass(i) * pl%Ip(3,i) * pl%radius(i)**2 * pl%rot(3,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 + else + kespincb = 0.0_DP + kespinpl(:) = 0.0_DP + end if + + if (param%lflatten_interactions) then + call swiftest_util_get_energy_potential_flat(npl, pl%nplpl, pl%k_plpl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, nbody_system%pe) + else + call swiftest_util_get_energy_potential_triangular(npl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, nbody_system%pe) + end if + + ! Potential energy from the oblateness term + if (param%loblatecb) 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 (param%lrotation) nbody_system%ke_spin = 0.5_DP * (kespincb + sum(kespinpl(1:npl), pl%lmask(1:npl))) + + nbody_system%Lorbit(1) = Lcborbit(1) + sum(Lplorbitx(1:npl), pl%lmask(1:npl)) + nbody_system%Lorbit(2) = Lcborbit(2) + sum(Lplorbity(1:npl), pl%lmask(1:npl)) + nbody_system%Lorbit(3) = Lcborbit(3) + sum(Lplorbitz(1:npl), pl%lmask(1:npl)) + + if (param%lrotation) then + nbody_system%Lspin(1) = Lcbspin(1) + sum(Lplspinx(1:npl), pl%lmask(1:npl)) + nbody_system%Lspin(2) = Lcbspin(2) + sum(Lplspiny(1:npl), pl%lmask(1:npl)) + nbody_system%Lspin(3) = Lcbspin(3) + sum(Lplspinz(1:npl), pl%lmask(1:npl)) + end if + + nbody_system%be = sum(-3*pl%Gmass(1:npl)*pl%mass(1:npl)/(5*pl%radius(1:npl)), pl%lmask(1:npl)) + + nbody_system%te = nbody_system%ke_orbit + nbody_system%ke_spin + nbody_system%pe + nbody_system%be + nbody_system%Ltot(:) = nbody_system%Lorbit(:) + nbody_system%Lspin(:) + end associate + + return + end subroutine swiftest_util_get_energy_momentum_system + + + subroutine swiftest_util_get_energy_potential_flat(npl, nplpl, k_plpl, lmask, GMcb, Gmass, mass, rb, pe) + !! author: David A. Minton + !! + !! Compute total nbody_system potential energy + implicit none + ! Arguments + integer(I4B), intent(in) :: npl + integer(I8B), intent(in) :: nplpl + integer(I4B), dimension(:,:), intent(in) :: k_plpl + logical, dimension(:), intent(in) :: lmask + real(DP), intent(in) :: GMcb + real(DP), dimension(:), intent(in) :: Gmass + real(DP), dimension(:), intent(in) :: mass + real(DP), dimension(:,:), intent(in) :: rb + real(DP), intent(out) :: pe + ! Internals + integer(I4B) :: i, j + integer(I8B) :: k + real(DP), dimension(npl) :: pecb + real(DP), dimension(nplpl) :: pepl + logical, dimension(nplpl) :: lstatpl + + ! Do the central body potential energy component first + where(.not. lmask(1:npl)) + pecb(1:npl) = 0.0_DP + end where + + do concurrent(i = 1:npl, lmask(i)) + pecb(i) = -GMcb * mass(i) / norm2(rb(:,i)) + end do + + !$omp parallel do default(private) schedule(static)& + !$omp shared(k_plpl, rb, mass, Gmass, pepl, lstatpl, lmask) & + !$omp firstprivate(nplpl) + do k = 1, nplpl + i = k_plpl(1,k) + j = k_plpl(2,k) + lstatpl(k) = (lmask(i) .and. lmask(j)) + if (lstatpl(k)) then + pepl(k) = -(Gmass(i) * mass(j)) / norm2(rb(:, i) - rb(:, j)) + else + pepl(k) = 0.0_DP + end if + end do + !$omp end parallel do + + pe = sum(pepl(:), lstatpl(:)) + sum(pecb(1:npl), lmask(1:npl)) + + return + end subroutine swiftest_util_get_energy_potential_flat + + + subroutine swiftest_util_get_energy_potential_triangular(npl, lmask, GMcb, Gmass, mass, rb, pe) + !! author: David A. Minton + !! + !! Compute total nbody_system potential energy + implicit none + ! Arguments + integer(I4B), intent(in) :: npl + logical, dimension(:), intent(in) :: lmask + real(DP), intent(in) :: GMcb + real(DP), dimension(:), intent(in) :: Gmass + real(DP), dimension(:), intent(in) :: mass + real(DP), dimension(:,:), intent(in) :: rb + real(DP), intent(out) :: pe + ! Internals + integer(I4B) :: i, j + real(DP), dimension(npl) :: pecb, pepl + + ! Do the central body potential energy component first + where(.not. lmask(1:npl)) + pecb(1:npl) = 0.0_DP + end where + + do concurrent(i = 1:npl, lmask(i)) + pecb(i) = -GMcb * mass(i) / norm2(rb(:,i)) + end do + + pe = 0.0_DP + !$omp parallel do default(private) schedule(static)& + !$omp shared(lmask, Gmass, mass, rb) & + !$omp firstprivate(npl) & + !$omp reduction(+:pe) + do i = 1, npl + if (lmask(i)) then + do concurrent(j = i+1:npl, lmask(i) .and. lmask(j)) + pepl(j) = - (Gmass(i) * mass(j)) / norm2(rb(:, i) - rb(:, j)) + end do + pe = pe + sum(pepl(i+1:npl), lmask(i+1:npl)) + end if + end do + !$omp end parallel do + pe = pe + sum(pecb(1:npl), lmask(1:npl)) + + return + end subroutine swiftest_util_get_energy_potential_triangular + + + module subroutine swiftest_util_index_array(ind_arr, n) + !! author: David A. Minton + !! + !! Creates or resizes an index array of size n where ind_arr = [1, 2, ... n]. + !! This subroutine swiftest_assumes that if ind_arr is already allocated, it is a pre-existing index array of a different size. + implicit none + ! Arguments + 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 + ! Internals + integer(I4B) :: nold, i + integer(I4B), dimension(:), allocatable :: itmp + + if (allocated(ind_arr)) then + nold = size(ind_arr) + if (nold == n) return ! Nothing to do, so go home + else + nold = 0 + end if + + allocate(itmp(n)) + if (n >= nold) then + if (nold > 0) itmp(1:nold) = ind_arr(1:nold) + itmp(nold+1:n) = [(i, i = nold + 1, n)] + call move_alloc(itmp, ind_arr) + else + itmp(1:n) = ind_arr(1:n) + call move_alloc(itmp, ind_arr) + end if + + return + end subroutine swiftest_util_index_array + + + module subroutine swiftest_util_get_idvalues_system(self, idvals) + !! author: David A. Minton + !! + !! Returns an array of all id values saved in this snapshot + implicit none + ! Arguments + 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 + ! Internals + integer(I4B) :: npl, ntp + + if (allocated(self%pl)) then + npl = self%pl%nbody + else + npl = 0 + end if + if (allocated(self%tp)) then + ntp = self%tp%nbody + else + ntp = 0 + end if + + allocate(idvals(1 + npl+ntp)) + + idvals(1) = self%cb%id + if (npl > 0) idvals(2:npl+1) = self%pl%id(:) + if (ntp > 0) idvals(npl+2:npl+ntp+1) = self%tp%id(:) + + return + + end subroutine swiftest_util_get_idvalues_system + + + module subroutine swiftest_util_get_vals_storage(self, idvals, tvals) + !! author: David A. Minton + !! + !! Gets the id values in a storage object, regardless of whether it is encounter of collision + ! Argument + 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 + ! Internals + integer(I4B) :: i, n, nlo, nhi, ntotal + integer(I4B), dimension(:), allocatable :: itmp + + associate(storage => self, nsnaps => self%iframe) + + allocate(tvals(nsnaps)) + tvals(:) = 0.0_DP + + ! First pass to get total number of ids + ntotal = 0 + do i = 1, nsnaps + if (allocated(storage%frame(i)%item)) then + select type(snapshot => storage%frame(i)%item) + class is (swiftest_nbody_system) + tvals(i) = snapshot%t + call snapshot%get_idvals(itmp) + if (allocated(itmp)) then + n = size(itmp) + ntotal = ntotal + n + end if + end select + end if + end do + + allocate(idvals(ntotal)) + nlo = 1 + ! Second pass to store all ids get all of the ids stored + do i = 1, nsnaps + if (allocated(storage%frame(i)%item)) then + select type(snapshot => storage%frame(i)%item) + class is (swiftest_nbody_system) + tvals(i) = snapshot%t + call snapshot%get_idvals(itmp) + if (allocated(itmp)) then + n = size(itmp) + nhi = nlo + n - 1 + idvals(nlo:nhi) = itmp(1:n) + nlo = nhi + 1 + end if + end select + end if + end do + + end associate + return + end subroutine swiftest_util_get_vals_storage + + + module subroutine swiftest_util_index_map_storage(self) + !! author: David A. Minton + !! + !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + implicit none + ! Arguments + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + ! Internals + integer(I4B), dimension(:), allocatable :: idvals + real(DP), dimension(:), allocatable :: tvals + + call swiftest_util_get_vals_storage(self, idvals, tvals) + + call swiftest_util_unique(idvals,self%idvals,self%idmap) + self%nid = size(self%idvals) + + call swiftest_util_unique(tvals,self%tvals,self%tmap) + self%nt = size(self%tvals) + + return + end subroutine swiftest_util_index_map_storage + + subroutine swiftest_util_peri(n,m, r, v, atp, q, isperi) + !! author: David A. Minton + !! + !! Helper function that does the pericenter passage computation for any body + !! + !! Adapted from David E. Kaufmann's Swifter routine: symba_peri.f90 + !! Adapted from Hal Levison's Swift routine util_mass_peri.f + implicit none + ! Arguments + 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 + ! Internals + integer(I4B) :: i + real(DP), dimension(n) :: e !! Temporary, just to make use of the xv2aeq subroutine + real(DP) :: vdotr + + do concurrent(i = 1:n) + vdotr = dot_product(r(:,i),v(:,i)) + if (isperi(i) == -1) then + if (vdotr >= 0.0) then + isperi(i) = 0 + call swiftest_orbel_xv2aeq(m(i),r(1,i),r(2,i),r(3,i),v(1,i),v(2,i),v(3,i),atp(i),e(i),q(i)) + end if + else + if (vdotr > 0.0) then + isperi(i) = -1 + else + isperi(i) = 1 + end if + end if + end do + + return + end subroutine swiftest_util_peri + + + module subroutine swiftest_util_peri_body(self, nbody_system, param) + !! author: David A. Minton + !! + !! Determine nbody_system pericenter passages for bodies + !! + !! Adapted from David E. Kaufmann's Swifter routine: symba_peri.f90 + !! Adapted from Hal Levison's Swift routine util_mass_peri.f + implicit none + ! Arguments + 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 + ! Internals + integer(I4B) :: i + + select type(self) + class is (swiftest_pl) + if (self%lfirst) self%isperi(:) = 0 + end select + + if (param%qmin_coord == "HELIO") then + call swiftest_util_peri(self%nbody, self%mu, self%rh, self%vh, self%atp, self%peri, self%isperi) + else + call swiftest_util_peri(self%nbody, [(nbody_system%Gmtot,i=1,self%nbody)], self%rb, self%vb, self%atp, self%peri, self%isperi) + end if + + return + end subroutine swiftest_util_peri_body + + + module subroutine swiftest_util_rearray_pl(self, nbody_system, param) + !! Author: the Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Clean up the massive body structures to remove discarded bodies and add new bodies + use symba + implicit none + ! Arguments + 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 + ! Internals + class(swiftest_pl), allocatable :: tmp !! The discarded body list. + integer(I4B) :: i, k, npl, nadd, nencmin, nenc_old, idnew1, idnew2, idold1, idold2 + logical, dimension(:), allocatable :: lmask, ldump_mask + class(encounter_list), allocatable :: plplenc_old + logical :: lencounter + + associate(pl => self, tp => nbody_system%tp, pl_adds => nbody_system%pl_adds) + + npl = pl%nbody + nadd = pl_adds%nbody + if (npl == 0) return + ! Deallocate any temporary variables + if (allocated(pl%rbeg)) deallocate(pl%rbeg) + if (allocated(pl%rend)) deallocate(pl%rend) + + ! Remove the discards and destroy the list, as the nbody_system already tracks pl_discards elsewhere + allocate(lmask(npl)) + lmask(1:npl) = pl%ldiscard(1:npl) + if (count(lmask(:)) > 0) then + allocate(tmp, mold=self) + call pl%spill(tmp, lspill_list=lmask, ldestructive=.true.) + npl = pl%nbody + call tmp%setup(0,param) + deallocate(tmp) + deallocate(lmask) + end if + + ! Store the original plplenc list so we don't remove any of the original encounters + nenc_old = nbody_system%plpl_encounter%nenc + if (nenc_old > 0) then + allocate(plplenc_old, source=nbody_system%plpl_encounter) + call plplenc_old%copy(nbody_system%plpl_encounter) + end if + + ! Add in any new bodies + if (nadd > 0) then + ! Append the adds to the main pl object + call pl%append(pl_adds, lsource_mask=[(.true., i=1, nadd)]) + + allocate(ldump_mask(npl+nadd)) ! This mask is used only to append the original Fortran binary particle.dat file with new bodies. This is ignored for NetCDF output + ldump_mask(1:npl) = .false. + ldump_mask(npl+1:npl+nadd) = pl%status(npl+1:npl+nadd) == NEW_PARTICLE + npl = pl%nbody + else + allocate(ldump_mask(npl)) + ldump_mask(:) = .false. + end if + + ! Reset all of the status flags for this body + pl%status(1:npl) = ACTIVE + do i = 1, npl + call pl%info(i)%set_value(status="ACTIVE") + end do + pl%ldiscard(1:npl) = .false. + pl%lcollision(1:npl) = .false. + pl%lmask(1:npl) = .true. + + if (param%lmtiny_pl) then + pl%lmtiny(1:npl) = pl%Gmass(1:npl) < param%GMTINY + where(pl%lmtiny(1:npl)) + pl%info(1:npl)%particle_type = PL_TINY_TYPE_NAME + elsewhere + pl%info(1:npl)%particle_type = PL_TYPE_NAME + end where + end if + + call pl%write_info(param%system_history%nc, param) + deallocate(ldump_mask) + + ! Reindex the new list of bodies + call pl%sort("mass", ascending=.false.) + call pl%flatten(param) + + ! Reset the kinship trackers + call pl%reset_kinship([(i, i=1, npl)]) + + ! Re-build the encounter list + ! Be sure to get the level info if this is a SyMBA nbody_system + select type(nbody_system) + class is (symba_nbody_system) + select type(pl) + class is (symba_pl) + select type(tp) + class is (symba_tp) + lencounter = pl%encounter_check(param, nbody_system, param%dt, nbody_system%irec) + if (tp%nbody > 0) then + lencounter = tp%encounter_check(param, nbody_system, param%dt, nbody_system%irec) + end if + end select + end select + end select + + + ! Re-index the encounter list as the index values may have changed + if (nenc_old > 0) then + nencmin = min(nbody_system%plpl_encounter%nenc, plplenc_old%nenc) + nbody_system%plpl_encounter%nenc = nencmin + do k = 1, nencmin + idnew1 = nbody_system%plpl_encounter%id1(k) + idnew2 = nbody_system%plpl_encounter%id2(k) + idold1 = plplenc_old%id1(k) + idold2 = plplenc_old%id2(k) + if ((idnew1 == idold1) .and. (idnew2 == idold2)) then + ! This is an encounter we already know about, so save the old information + nbody_system%plpl_encounter%lvdotr(k) = plplenc_old%lvdotr(k) + nbody_system%plpl_encounter%lclosest(k) = plplenc_old%lclosest(k) + nbody_system%plpl_encounter%status(k) = plplenc_old%status(k) + nbody_system%plpl_encounter%r1(:,k) = plplenc_old%r1(:,k) + nbody_system%plpl_encounter%r2(:,k) = plplenc_old%r2(:,k) + nbody_system%plpl_encounter%v1(:,k) = plplenc_old%v1(:,k) + nbody_system%plpl_encounter%v2(:,k) = plplenc_old%v2(:,k) + nbody_system%plpl_encounter%tcollision(k) = plplenc_old%tcollision(k) + nbody_system%plpl_encounter%level(k) = plplenc_old%level(k) + else if (((idnew1 == idold2) .and. (idnew2 == idold1))) then + ! This is an encounter we already know about, but with the order reversed, so save the old information + nbody_system%plpl_encounter%lvdotr(k) = plplenc_old%lvdotr(k) + nbody_system%plpl_encounter%lclosest(k) = plplenc_old%lclosest(k) + nbody_system%plpl_encounter%status(k) = plplenc_old%status(k) + nbody_system%plpl_encounter%r1(:,k) = plplenc_old%r2(:,k) + nbody_system%plpl_encounter%r2(:,k) = plplenc_old%r1(:,k) + nbody_system%plpl_encounter%v1(:,k) = plplenc_old%v2(:,k) + nbody_system%plpl_encounter%v2(:,k) = plplenc_old%v1(:,k) + nbody_system%plpl_encounter%tcollision(k) = plplenc_old%tcollision(k) + nbody_system%plpl_encounter%level(k) = plplenc_old%level(k) + end if + nbody_system%plpl_encounter%index1(k) = findloc(pl%id(1:npl), nbody_system%plpl_encounter%id1(k), dim=1) + nbody_system%plpl_encounter%index2(k) = findloc(pl%id(1:npl), nbody_system%plpl_encounter%id2(k), dim=1) + end do + if (allocated(lmask)) deallocate(lmask) + allocate(lmask(nencmin)) + nenc_old = nencmin + if (any(nbody_system%plpl_encounter%index1(1:nencmin) == 0) .or. any(nbody_system%plpl_encounter%index2(1:nencmin) == 0)) then + lmask(:) = nbody_system%plpl_encounter%index1(1:nencmin) /= 0 .and. nbody_system%plpl_encounter%index2(1:nencmin) /= 0 + else + return + end if + nencmin = count(lmask(:)) + nbody_system%plpl_encounter%nenc = nencmin + if (nencmin > 0) then + nbody_system%plpl_encounter%index1(1:nencmin) = pack(nbody_system%plpl_encounter%index1(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%index2(1:nencmin) = pack(nbody_system%plpl_encounter%index2(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%id1(1:nencmin) = pack(nbody_system%plpl_encounter%id1(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%id2(1:nencmin) = pack(nbody_system%plpl_encounter%id2(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%lvdotr(1:nencmin) = pack(nbody_system%plpl_encounter%lvdotr(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%lclosest(1:nencmin) = pack(nbody_system%plpl_encounter%lclosest(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%status(1:nencmin) = pack(nbody_system%plpl_encounter%status(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%tcollision(1:nencmin) = pack(nbody_system%plpl_encounter%tcollision(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%level(1:nencmin) = pack(nbody_system%plpl_encounter%level(1:nenc_old), lmask(1:nenc_old)) + do i = 1, NDIM + nbody_system%plpl_encounter%r1(i, 1:nencmin) = pack(nbody_system%plpl_encounter%r1(i, 1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%r2(i, 1:nencmin) = pack(nbody_system%plpl_encounter%r2(i, 1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%v1(i, 1:nencmin) = pack(nbody_system%plpl_encounter%v1(i, 1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%v2(i, 1:nencmin) = pack(nbody_system%plpl_encounter%v2(i, 1:nenc_old), lmask(1:nenc_old)) + end do + end if + end if + end associate + + return + end subroutine swiftest_util_rearray_pl + + + module subroutine swiftest_util_rescale_system(self, param, mscale, dscale, tscale) + !! author: David A. Minton + !! + !! Rescales an nbody system to a new set of units. Inputs are the multipliers on the mass (mscale), distance (dscale), and time units (tscale). + !! Rescales all united quantities in the nbody_system, as well as the mass conversion factors, gravitational constant, and Einstein's constant in the parameter object. + 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. + ! Internals + real(DP) :: vscale + + param%MU2KG = param%MU2KG * mscale + param%DU2M = param%DU2M * dscale + param%TU2S = param%TU2S * tscale + + ! Calculate the G for the nbody_system units + param%GU = GC / (param%DU2M**3 / (param%MU2KG * param%TU2S**2)) + + if (param%lgr) then + ! Calculate the inverse speed of light in the nbody_system units + param%inv_c2 = einsteinC * param%TU2S / param%DU2M + param%inv_c2 = (param%inv_c2)**(-2) + end if + + vscale = dscale / tscale + + associate(cb => self%cb, pl => self%pl, npl => self%pl%nbody, tp => self%tp, ntp => self%tp%nbody) + + cb%mass = cb%mass / mscale + cb%Gmass = param%GU * cb%mass + cb%radius = cb%radius / dscale + cb%rb(:) = cb%rb(:) / dscale + cb%vb(:) = cb%vb(:) / vscale + cb%rot(:) = cb%rot(:) * tscale + pl%mass(1:npl) = pl%mass(1:npl) / mscale + pl%Gmass(1:npl) = param%GU * pl%mass(1:npl) + pl%radius(1:npl) = pl%radius(1:npl) / dscale + pl%rh(:,1:npl) = pl%rh(:,1:npl) / dscale + pl%vh(:,1:npl) = pl%vh(:,1:npl) / vscale + pl%rb(:,1:npl) = pl%rb(:,1:npl) / dscale + pl%vb(:,1:npl) = pl%vb(:,1:npl) / vscale + pl%rot(:,1:npl) = pl%rot(:,1:npl) * tscale + + end associate + + + return + end subroutine swiftest_util_rescale_system + + + module subroutine swiftest_util_reset_kinship_pl(self, idx) + !! author: David A. Minton + !! + !! Resets the kinship status of bodies. + !! + implicit none + class(swiftest_pl), intent(inout) :: self !! SyMBA massive body object + integer(I4B), dimension(:), intent(in) :: idx !! Index array of bodies to reset + ! Internals + integer(I4B) :: i, j + + + self%kin(idx(:))%parent = idx(:) + self%kin(idx(:))%nchild = 0 + do j = 1, size(idx(:)) + i = idx(j) + if (allocated(self%kin(i)%child)) deallocate(self%kin(i)%child) + end do + + return + end subroutine swiftest_util_reset_kinship_pl + + + module subroutine swiftest_util_resize_arr_char_string(arr, nnew) + !! 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 + ! Internals + character(len=STRMAX), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated + integer(I4B) :: nold !! Old size + + if (nnew < 0) return + + if (nnew == 0) then + if (allocated(arr)) deallocate(arr) + return + end if + + if (allocated(arr)) then + nold = size(arr) + else + nold = 0 + end if + + if (nnew == nold) return + + allocate(tmp(nnew)) + if (nold > 0) then + if (nnew > nold) then + tmp(1:nold) = arr(1:nold) + tmp(nold+1:nnew) = "" + else + tmp(1:nnew) = arr(1:nnew) + end if + else + tmp(1:nnew) = "" + end if + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_resize_arr_char_string + + + module subroutine swiftest_util_resize_arr_DP(arr, nnew) + !! 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 + ! Internals + 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 + + if (nnew == 0) then + if (allocated(arr)) deallocate(arr) + return + end if + + if (allocated(arr)) then + nold = size(arr) + else + nold = 0 + end if + + if (nnew == nold) return + + allocate(tmp(nnew)) + if (nold > 0) then + if (nnew > nold) then + tmp(1:nold) = arr(1:nold) + tmp(nold+1:nnew) = init_val + else + tmp(1:nnew) = arr(1:nnew) + end if + else + tmp(1:nnew) = init_val + end if + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_resize_arr_DP + + + module subroutine swiftest_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. + implicit none + ! Arguments + 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(NDIM), parameter :: init_val = 0.0_DP + integer(I4B) :: i + + if (nnew < 0) return + + if (nnew == 0) then + if (allocated(arr)) deallocate(arr) + return + end if + + if (allocated(arr)) then + nold = size(arr, dim=2) + else + nold = 0 + end if + + if (nnew == nold) return + + allocate(tmp(NDIM, nnew)) + if (nold > 0) then + if (nnew > nold) then + tmp(:,1:nold) = arr(:,1:nold) + do i = nold+1, nnew + tmp(:,i) = init_val(:) + end do + else + tmp(:,1:nnew) = arr(:,1:nnew) + end if + else + do i = 1, nnew + tmp(:, i) = init_val(:) + end do + end if + call move_alloc(tmp, arr) + + return + + return + end subroutine swiftest_util_resize_arr_DPvec + + + module subroutine swiftest_util_resize_arr_I4B(arr, nnew) + !! 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 + ! Internals + 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 + + if (nnew == 0) then + if (allocated(arr)) deallocate(arr) + return + end if + + if (allocated(arr)) then + nold = size(arr) + else + nold = 0 + end if + + if (nnew == nold) return + + allocate(tmp(nnew)) + if (nold > 0) then + if (nnew > nold) then + tmp(1:nold) = arr(1:nold) + tmp(nold+1:nnew) = init_val + else + tmp(1:nnew) = arr(1:nnew) + end if + else + tmp(1:nnew) = init_val + end if + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_resize_arr_I4B + + + module subroutine swiftest_util_resize_arr_info(arr, nnew) + !! author: David A. Minton + !! + !! Resizes an array component of type character string. Array will only be resized if has previously been allocated. Passing nnew = 0 will deallocate. + implicit none + ! Arguments + type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + ! Internals + type(swiftest_particle_info), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated + integer(I4B) :: nold !! Old size + + if (nnew < 0) return + + if (nnew == 0) then + if (allocated(arr)) deallocate(arr) + return + end if + + if (allocated(arr)) then + nold = size(arr) + else + nold = 0 + end if + + if (nnew == nold) return + + allocate(tmp(nnew)) + if (nnew > nold) then + call swiftest_util_copy_particle_info_arr(arr(1:nold), tmp(1:nold)) + else + call swiftest_util_copy_particle_info_arr(arr(1:nnew), tmp(1:nnew)) + end if + + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_resize_arr_info + + + module subroutine swiftest_util_resize_arr_kin(arr, nnew) + !! author: David A. Minton + !! + !! Resizes an array component of type character string. Array will only be resized if has previously been allocated. Passing nnew = 0 will deallocate. + implicit none + ! Arguments + type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + ! Internals + type(swiftest_kinship), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated + integer(I4B) :: nold !! Old size + + if (nnew < 0) return + + if (nnew == 0) then + if (allocated(arr)) deallocate(arr) + return + end if + + if (allocated(arr)) then + nold = size(arr) + else + nold = 0 + end if + + allocate(tmp(nnew)) + if (nnew > nold) then + tmp(1:nold) = arr(1:nold) + else + tmp(1:nnew) = arr(1:nnew) + end if + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_resize_arr_kin + + + module subroutine swiftest_util_resize_arr_logical(arr, nnew) + !! 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 + ! Internals + 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 + + if (nnew == 0) then + if (allocated(arr)) deallocate(arr) + return + end if + + if (allocated(arr)) then + nold = size(arr) + else + nold = 0 + end if + + if (nnew == nold) return + + allocate(tmp(nnew)) + if (nold > 0) then + if (nnew > nold) then + tmp(1:nold) = arr(1:nold) + tmp(nold+1:nnew) = init_val + else + tmp(1:nnew) = arr(1:nnew) + end if + else + tmp(1:nnew) = init_val + end if + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_resize_arr_logical + + + module subroutine swiftest_util_resize_body(self, nnew) + !! author: David A. Minton + !! + !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. + implicit none + ! Arguments + class(swiftest_body), intent(inout) :: self !! Swiftest body object + integer(I4B), intent(in) :: nnew !! New size neded + + call swiftest_util_resize(self%info, nnew) + call swiftest_util_resize(self%id, nnew) + call swiftest_util_resize(self%status, nnew) + call swiftest_util_resize(self%lcollision, nnew) + call swiftest_util_resize(self%lencounter, nnew) + call swiftest_util_resize(self%ldiscard, nnew) + call swiftest_util_resize(self%lmask, nnew) + call swiftest_util_resize(self%mu, nnew) + call swiftest_util_resize(self%rh, nnew) + call swiftest_util_resize(self%vh, nnew) + call swiftest_util_resize(self%rb, nnew) + call swiftest_util_resize(self%vb, nnew) + call swiftest_util_resize(self%ah, nnew) + call swiftest_util_resize(self%aobl, nnew) + call swiftest_util_resize(self%atide, nnew) + call swiftest_util_resize(self%agr, nnew) + call swiftest_util_resize(self%ir3h, nnew) + call swiftest_util_resize(self%a, nnew) + call swiftest_util_resize(self%e, nnew) + call swiftest_util_resize(self%inc, nnew) + call swiftest_util_resize(self%capom, nnew) + call swiftest_util_resize(self%omega, nnew) + call swiftest_util_resize(self%capm, nnew) + self%nbody = count(self%status(1:nnew) /= INACTIVE) + + return + end subroutine swiftest_util_resize_body + + + module subroutine swiftest_util_resize_pl(self, nnew) + !! author: David A. Minton + !! + !! Checks the current size of a Swiftest massive body against the requested size and resizes it if it is too small. + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + integer(I4B), intent(in) :: nnew !! New size neded + + call swiftest_util_resize_body(self, nnew) + + call swiftest_util_resize(self%mass, nnew) + call swiftest_util_resize(self%Gmass, nnew) + call swiftest_util_resize(self%rhill, nnew) + call swiftest_util_resize(self%renc, nnew) + call swiftest_util_resize(self%radius, nnew) + call swiftest_util_resize(self%rbeg, nnew) + call swiftest_util_resize(self%rend, nnew) + call swiftest_util_resize(self%vbeg, nnew) + call swiftest_util_resize(self%density, nnew) + call swiftest_util_resize(self%Ip, nnew) + call swiftest_util_resize(self%rot, nnew) + call swiftest_util_resize(self%k2, nnew) + call swiftest_util_resize(self%Q, nnew) + call swiftest_util_resize(self%tlag, nnew) + call swiftest_util_resize(self%kin, nnew) + call swiftest_util_resize(self%lmtiny, nnew) + call swiftest_util_resize(self%nplenc, nnew) + call swiftest_util_resize(self%ntpenc, nnew) + + + + if (allocated(self%k_plpl)) deallocate(self%k_plpl) + + return + end subroutine swiftest_util_resize_pl + + + module subroutine swiftest_util_resize_tp(self, nnew) + !! author: David A. Minton + !! + !! Checks the current size of a Swiftest test particle against the requested size and resizes it if it is too small. + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + integer(I4B), intent(in) :: nnew !! New size neded + + call swiftest_util_resize_body(self, nnew) + + call swiftest_util_resize(self%nplenc, nnew) + call swiftest_util_resize(self%isperi, nnew) + call swiftest_util_resize(self%peri, nnew) + call swiftest_util_resize(self%atp, nnew) + + return + end subroutine swiftest_util_resize_tp + + + module subroutine swiftest_util_set_beg_end_pl(self, rbeg, rend, vbeg) + !! author: David A. Minton + !! + !! Sets one or more of the values of rbeg, rend, and vbeg + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + real(DP), dimension(:,:), intent(in), optional :: rbeg, rend, vbeg + + if (present(rbeg)) then + if (allocated(self%rbeg)) deallocate(self%rbeg) + allocate(self%rbeg, source=rbeg) + end if + if (present(rend)) then + if (allocated(self%rend)) deallocate(self%rend) + allocate(self%rend, source=rend) + end if + if (present(vbeg)) then + if (allocated(self%vbeg)) deallocate(self%vbeg) + allocate(self%vbeg, source=vbeg) + end if + + return + end subroutine swiftest_util_set_beg_end_pl + + + module subroutine swiftest_util_set_ir3h(self) + !! author: David A. Minton + !! + !! Sets the inverse heliocentric radius term (1/rh**3) for all bodies in a structure + implicit none + ! Arguments + class(swiftest_body), intent(inout) :: self !! Swiftest generic body object + ! Internals + integer(I4B) :: i + real(DP) :: r2, irh + + if (self%nbody > 0) then + + do i = 1, self%nbody + r2 = dot_product(self%rh(:, i), self%rh(:, i)) + irh = 1.0_DP / sqrt(r2) + self%ir3h(i) = irh / r2 + end do + end if + + return + end subroutine swiftest_util_set_ir3h + + + module subroutine swiftest_util_set_msys(self) + !! author: David A. Minton + !! + !! Sets the value of msys and the vector mass quantities based on the total mass of the nbody_system + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nobdy nbody_system object + + self%Gmtot = self%cb%Gmass + sum(self%pl%Gmass(1:self%pl%nbody), self%pl%status(1:self%pl%nbody) /= INACTIVE) + + return + end subroutine swiftest_util_set_msys + + + module subroutine swiftest_util_set_mu_pl(self, cb) + !! author: David A. Minton + !! + !! Computes G * (M + m) for each massive body + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + + if (self%nbody > 0) self%mu(1:self%nbody) = cb%Gmass + self%Gmass(1:self%nbody) + + return + end subroutine swiftest_util_set_mu_pl + + + module subroutine swiftest_util_set_mu_tp(self, cb) + !! author: David A. Minton + !! + !! Converts certain scalar values to arrays so that they can be used in elemental functions + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + + if (self%nbody == 0) return + self%mu(1:self%nbody) = cb%Gmass + + return + 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) + !! author: David A. Minton + !! + !! Sets one or more values of the particle information metadata object + implicit none + ! Arguments + 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) + ! Internals + character(len=NAMELEN) :: lenstr + character(len=:), allocatable :: fmtlabel + + write(lenstr, *) NAMELEN + fmtlabel = "(A" // trim(adjustl(lenstr)) // ")" + + if (present(name)) then + write(self%name, fmtlabel) trim(adjustl(name)) + end if + if (present(particle_type)) then + write(self%particle_type, fmtlabel) trim(adjustl(particle_type)) + end if + if (present(status)) then + write(self%status, fmtlabel) trim(adjustl(status)) + end if + if (present(origin_type)) then + write(self%origin_type, fmtlabel) trim(adjustl(origin_type)) + end if + if (present(origin_time)) then + self%origin_time = origin_time + end if + if (present(collision_id)) then + self%collision_id = collision_id + end if + if (present(origin_rh)) then + self%origin_rh(:) = origin_rh(:) + end if + if (present(origin_vh)) then + self%origin_vh(:) = origin_vh(:) + end if + if (present(discard_time)) then + self%discard_time = discard_time + end if + if (present(discard_rh)) then + self%discard_rh(:) = discard_rh(:) + end if + if (present(discard_vh)) then + self%discard_vh(:) = discard_vh(:) + end if + if (present(discard_body_id)) then + self%discard_body_id = discard_body_id + end if + + return + end subroutine swiftest_util_set_particle_info + + + module subroutine swiftest_util_set_renc_I4B(self, scale) + !! author: David A. Minton + !! + !! Sets the critical radius for encounter given an input scale factor + !! + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + integer(I4B), intent(in) :: scale !! Input scale factor (multiplier of Hill's sphere size) + + associate(pl => self, npl => self%nbody) + pl%renc(1:npl) = pl%rhill(1:npl) * scale + end associate + + return + end subroutine swiftest_util_set_renc_I4B + + + module subroutine swiftest_util_set_renc_DP(self, scale) + !! author: David A. Minton + !! + !! Sets the critical radius for encounter given an input scale factor + !! + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + real(DP), intent(in) :: scale !! Input scale factor (multiplier of Hill's sphere size) + + associate(pl => self, npl => self%nbody) + pl%renc(1:npl) = pl%rhill(1:npl) * scale + end associate + + return + end subroutine swiftest_util_set_renc_DP + + + module subroutine swiftest_util_set_rhill(self,cb) + !! author: David A. Minton + !! + !! Sets the value of the Hill's radius + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + + if (self%nbody == 0) return + + call self%xv2el(cb) + where(self%a(1:self%nbody) > 0.0_DP) + self%rhill(1:self%nbody) = self%a(1:self%nbody) * (self%Gmass(1:self%nbody) / cb%Gmass / 3)**THIRD + elsewhere + self%rhill(1:self%nbody) = (.mag.self%rh(:,1:self%nbody)) * (self%Gmass(1:self%nbody) / cb%Gmass / 3)**THIRD + end where + + return + end subroutine swiftest_util_set_rhill + + + module subroutine swiftest_util_set_rhill_approximate(self,cb) + !! author: David A. Minton + !! + !! Sets the approximate value of the Hill's radius using the heliocentric radius instead of computing the semimajor axis + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + ! Internals + real(DP), dimension(:), allocatable :: rh + + if (self%nbody == 0) return + + rh(1:self%nbody) = .mag. self%rh(:,1:self%nbody) + self%rhill(1:self%nbody) = rh(1:self%nbody) * (self%Gmass(1:self%nbody) / cb%Gmass / 3)**THIRD + + return + end subroutine swiftest_util_set_rhill_approximate + + + module subroutine swiftest_util_setup_construct_system(nbody_system, param) + !! author: David A. Minton + !! + !! Constructor for a Swiftest nbody system. Creates the nbody system object based on the user-input integrator + !! + implicit none + ! Arguments + class(swiftest_nbody_system), allocatable, intent(inout) :: nbody_system !! Swiftest nbody_system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + type(encounter_storage) :: encounter_history + type(collision_storage) :: collision_history + + allocate(swiftest_storage(param%dump_cadence) :: param%system_history) + allocate(swiftest_netcdf_parameters :: param%system_history%nc) + call param%system_history%reset() + + select case(param%integrator) + case (INT_BS) + write(*,*) 'Bulirsch-Stoer integrator not yet enabled' + case (INT_HELIO) + allocate(helio_nbody_system :: nbody_system) + select type(nbody_system) + class is (helio_nbody_system) + allocate(helio_cb :: nbody_system%cb) + allocate(helio_pl :: nbody_system%pl) + allocate(helio_tp :: nbody_system%tp) + allocate(helio_tp :: nbody_system%tp_discards) + end select + param%collision_model = "MERGE" + case (INT_RA15) + write(*,*) 'Radau integrator not yet enabled' + case (INT_TU4) + write(*,*) 'INT_TU4 integrator not yet enabled' + case (INT_WHM) + allocate(whm_nbody_system :: nbody_system) + select type(nbody_system) + class is (whm_nbody_system) + allocate(whm_cb :: nbody_system%cb) + allocate(whm_pl :: nbody_system%pl) + allocate(whm_tp :: nbody_system%tp) + allocate(whm_tp :: nbody_system%tp_discards) + end select + param%collision_model = "MERGE" + case (INT_RMVS) + allocate(rmvs_nbody_system :: nbody_system) + select type(nbody_system) + class is (rmvs_nbody_system) + allocate(rmvs_cb :: nbody_system%cb) + allocate(rmvs_pl :: nbody_system%pl) + allocate(rmvs_tp :: nbody_system%tp) + allocate(rmvs_tp :: nbody_system%tp_discards) + end select + param%collision_model = "MERGE" + case (INT_SYMBA) + allocate(symba_nbody_system :: nbody_system) + select type(nbody_system) + class is (symba_nbody_system) + allocate(symba_cb :: nbody_system%cb) + allocate(symba_pl :: nbody_system%pl) + allocate(symba_tp :: nbody_system%tp) + + allocate(symba_tp :: nbody_system%tp_discards) + allocate(symba_pl :: nbody_system%pl_adds) + allocate(symba_pl :: nbody_system%pl_discards) + + allocate(symba_list_pltp :: nbody_system%pltp_encounter) + allocate(symba_list_plpl :: nbody_system%plpl_encounter) + allocate(collision_list_plpl :: nbody_system%plpl_collision) + + if (param%lenc_save_trajectory .or. param%lenc_save_closest) then + allocate(encounter_netcdf_parameters :: encounter_history%nc) + call encounter_history%reset() + select type(nc => encounter_history%nc) + class is (encounter_netcdf_parameters) + nc%file_number = param%iloop / param%dump_cadence + end select + allocate(nbody_system%encounter_history, source=encounter_history) + end if + + allocate(collision_netcdf_parameters :: collision_history%nc) + call collision_history%reset() + select type(nc => collision_history%nc) + class is (collision_netcdf_parameters) + nc%file_number = param%iloop / param%dump_cadence + end select + allocate(nbody_system%collision_history, source=collision_history) + + end select + case (INT_RINGMOONS) + write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' + case default + write(*,*) 'Unkown integrator',param%integrator + call util_exit(FAILURE) + end select + + allocate(swiftest_particle_info :: nbody_system%cb%info) + + select case(param%collision_model) + case("MERGE") + allocate(collision_basic :: nbody_system%collider) + case("BOUNCE") + allocate(collision_bounce :: nbody_system%collider) + case("FRAGGLE") + allocate(collision_fraggle :: nbody_system%collider) + end select + call nbody_system%collider%setup(nbody_system) + + + return + end subroutine swiftest_util_setup_construct_system + + + module subroutine swiftest_util_setup_initialize_particle_info_system(self, param) + !! author: David A. Minton + !! + !! Setup up particle information metadata from initial conditions + ! + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i + + associate(pl => self%pl, npl => self%pl%nbody, tp => self%tp, ntp => self%tp%nbody) + + if (.not. allocated(self%cb%info)) allocate(swiftest_particle_info :: self%cb%info) + + call self%cb%info%set_value(particle_type=CB_TYPE_NAME, status="ACTIVE", origin_type="Initial conditions", & + origin_time=param%t0, origin_rh=[0.0_DP, 0.0_DP, 0.0_DP], origin_vh=[0.0_DP, 0.0_DP, 0.0_DP]) + do i = 1, self%pl%nbody + call pl%info(i)%set_value(particle_type=PL_TYPE_NAME, status="ACTIVE", origin_type="Initial conditions", & + origin_time=param%t0, origin_rh=self%pl%rh(:,i), origin_vh=self%pl%vh(:,i)) + end do + do i = 1, self%tp%nbody + call tp%info(i)%set_value(particle_type=TP_TYPE_NAME, status="ACTIVE", origin_type="Initial conditions", & + origin_time=param%t0, origin_rh=self%tp%rh(:,i), origin_vh=self%tp%vh(:,i)) + end do + + end associate + + return + end subroutine swiftest_util_setup_initialize_particle_info_system + + + module subroutine swiftest_util_setup_initialize_system(self, param) + !! author: David A. Minton + !! + !! Wrapper method to initialize a basic Swiftest nbody system from files + !! + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + + associate(nbody_system => self, cb => self%cb, pl => self%pl, tp => self%tp) + + call nbody_system%read_in(param) + call nbody_system%validate_ids(param) + call nbody_system%set_msys() + call pl%set_mu(cb) + call tp%set_mu(cb) + if (param%in_form == "EL") then + call pl%el2xv(cb) + call tp%el2xv(cb) + end if + call pl%flatten(param) + if (.not.param%lrhill_present) call pl%set_rhill(cb) + pl%lfirst = param%lfirstkick + tp%lfirst = param%lfirstkick + + if (.not.param%lrestart) then + call nbody_system%init_particle_info(param) + end if + end associate + + return + end subroutine swiftest_util_setup_initialize_system + + + module subroutine swiftest_util_setup_body(self, n, param) + !! author: David A. Minton + !! + !! Constructor for base Swiftest particle class. Allocates space for all particles and + !! initializes all components with a value. + !! Note: Timing tests indicate that (NDIM, n) is more efficient than (NDIM, n) + implicit none + ! Arguments + class(swiftest_body), intent(inout) :: self !! Swiftest generic body object + integer(I4B), intent(in) :: n !! Number of particles to allocate space for + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter + ! Internals + integer(I4B) :: i + + if (n < 0) return + + self%lfirst = .true. + + call self%dealloc() + + self%nbody = n + if (n == 0) return + + allocate(swiftest_particle_info :: self%info(n)) + allocate(self%id(n)) + allocate(self%status(n)) + allocate(self%ldiscard(n)) + allocate(self%lmask(n)) + allocate(self%mu(n)) + allocate(self%rh(NDIM, n)) + allocate(self%vh(NDIM, n)) + allocate(self%rb(NDIM, n)) + allocate(self%vb(NDIM, n)) + allocate(self%ah(NDIM, n)) + allocate(self%ir3h(n)) + allocate(self%aobl(NDIM, n)) + allocate(self%isperi(n)) + allocate(self%peri(n)) + allocate(self%atp(n)) + if (param%lclose) then + allocate(self%lcollision(n)) + allocate(self%lencounter(n)) + self%lcollision(:) = .false. + self%lencounter(:) = .false. + end if + + self%id(:) = 0 + do i = 1, n + call self%info(i)%set_value(& + name = "UNNAMED", & + particle_type = "UNKNOWN", & + status = "INACTIVE", & + origin_type = "UNKNOWN", & + collision_id = 0, & + origin_time = -huge(1.0_DP), & + origin_rh = [0.0_DP, 0.0_DP, 0.0_DP], & + origin_vh = [0.0_DP, 0.0_DP, 0.0_DP], & + discard_time = huge(1.0_DP), & + discard_rh = [0.0_DP, 0.0_DP, 0.0_DP], & + discard_vh = [0.0_DP, 0.0_DP, 0.0_DP], & + discard_body_id = -1 & + ) + end do + + self%status(:) = INACTIVE + self%ldiscard(:) = .false. + self%lmask(:) = .false. + self%mu(:) = 0.0_DP + self%rh(:,:) = 0.0_DP + self%vh(:,:) = 0.0_DP + self%rb(:,:) = 0.0_DP + self%vb(:,:) = 0.0_DP + self%ah(:,:) = 0.0_DP + self%ir3h(:) = 0.0_DP + self%aobl(:,:) = 0.0_DP + self%isperi(:) = 1 + self%peri(:) = 0.0_DP + self%atp(:) = 0.0_DP + + if (param%ltides) then + allocate(self%atide(NDIM, n)) + self%atide(:,:) = 0.0_DP + end if + if (param%lgr) then + allocate(self%agr(NDIM, n)) + self%agr(:,:) = 0.0_DP + end if + + return + end subroutine swiftest_util_setup_body + + + module subroutine swiftest_util_setup_pl(self, n, param) + !! author: David A. Minton + !! + !! Constructor for base Swiftest massive body class. Allocates space for all particles and + !! initializes all components with a value. + implicit none + ! Arguments + 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 parameter + ! Internals + integer(I4B) :: i + + !> Call allocation method for parent class + !> The parent class here is the abstract swiftest_body class, so we can't use the type-bound procedure + call swiftest_util_setup_body(self, n, param) + if (n == 0) return + + allocate(self%mass(n)) + allocate(self%Gmass(n)) + allocate(self%rhill(n)) + allocate(self%renc(n)) + + self%mass(:) = 0.0_DP + self%Gmass(:) = 0.0_DP + self%rhill(:) = 0.0_DP + self%renc(:) = 0.0_DP + + self%nplpl = 0 + + if (param%lclose) then + allocate(self%nplenc(n)) + allocate(self%ntpenc(n)) + allocate(self%radius(n)) + allocate(self%density(n)) + allocate(self%kin(n)) + + self%nplenc(:) = 0 + self%ntpenc(:) = 0 + self%radius(:) = 0.0_DP + self%density(:) = 1.0_DP + call self%reset_kinship([(i, i=1, n)]) + end if + + if (param%lmtiny_pl) then + allocate(self%lmtiny(n)) + self%lmtiny(:) = .false. + end if + + if (param%lrotation) then + allocate(self%rot(NDIM, n)) + allocate(self%Ip(NDIM, n)) + self%rot(:,:) = 0.0_DP + self%Ip(:,:) = 0.0_DP + end if + + if (param%ltides) then + allocate(self%k2(n)) + allocate(self%Q(n)) + allocate(self%tlag(n)) + self%k2(:) = 0.0_DP + self%Q(:) = 0.0_DP + self%tlag(:) = 0.0_DP + end if + + return + end subroutine swiftest_util_setup_pl + + + module subroutine swiftest_util_setup_tp(self, n, param) + !! author: David A. Minton + !! + !! Constructor for base Swiftest test particle particle class. Allocates space for + !! all particles and initializes all components with a value. + implicit none + ! Arguments + 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 parameter + + !> Call allocation method for parent class + !> The parent class here is the abstract swiftest_body class, so we can't use the type-bound procedure + call swiftest_util_setup_body(self, n, param) + if (n == 0) return + + allocate(self%nplenc(n)) + + self%npltp = 0_I8B + self%nplenc(:) = 0 + + return + end subroutine swiftest_util_setup_tp + + + module subroutine swiftest_util_snapshot_system(self, param, nbody_system, t, arg) + !! author: David A. Minton + !! + !! Takes a snapshot of the nbody_system for later file storage + implicit none + ! Arguments + 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) + + self%iframe = self%iframe + 1 + self%nt = self%iframe + self%frame(self%iframe) = nbody_system ! Store a snapshot of the nbody_system for posterity + self%nid = self%nid + 1 ! Central body + if (allocated(nbody_system%pl)) self%nid = self%nid + nbody_system%pl%nbody + if (allocated(nbody_system%tp)) self%nid = self%nid + nbody_system%tp%nbody + + return + end subroutine swiftest_util_snapshot_system + + + module subroutine swiftest_util_sort_body(self, sortby, ascending) + !! author: David A. Minton + !! + !! Sort a Swiftest body structure in-place. + !! sortby is a string indicating which array component to sort. + implicit none + ! Arguments + 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 + ! Internals + integer(I4B), dimension(:), allocatable :: ind + integer(I4B) :: direction + + if (self%nbody == 0) return + + if (ascending) then + direction = 1 + else + direction = -1 + end if + + associate(body => self, n => self%nbody) + select case(sortby) + case("id") + call swiftest_util_sort(direction * body%id(1:n), ind) + case("status") + call swiftest_util_sort(direction * body%status(1:n), ind) + case("ir3h") + call swiftest_util_sort(direction * body%ir3h(1:n), ind) + case("a") + call swiftest_util_sort(direction * body%a(1:n), ind) + case("e") + call swiftest_util_sort(direction * body%e(1:n), ind) + case("inc") + call swiftest_util_sort(direction * body%inc(1:n), ind) + case("capom") + call swiftest_util_sort(direction * body%capom(1:n), ind) + case("mu") + call swiftest_util_sort(direction * body%mu(1:n), ind) + case("peri") + call swiftest_util_sort(direction * body%peri(1:n), ind) + case("atp") + call swiftest_util_sort(direction * body%atp(1:n), ind) + case("info", "lfirst", "nbody", "ldiscard", "lcollision", "lencounter", "rh", "vh", "rb", "vb", "ah", "aobl", "atide", "agr","isperi") + write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' + case default + write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not found!' + return + end select + + call body%rearrange(ind) + + end associate + + return + end subroutine swiftest_util_sort_body + + + pure module subroutine swiftest_util_sort_dp(arr) + !! 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 + + call swiftest_util_sort_qsort_DP(arr) + + return + end subroutine swiftest_util_sort_dp + + + pure module subroutine swiftest_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. + !! + implicit none + ! Arguments + real(DP), dimension(:), intent(in) :: arr + integer(I4B), dimension(:), allocatable, intent(inout) :: ind + ! Internals + integer(I4B) :: n, i + real(DP), dimension(:), allocatable :: tmparr + + n = size(arr) + if (.not.allocated(ind)) then + allocate(ind(n)) + ind = [(i, i=1, n)] + end if + allocate(tmparr, mold=arr) + tmparr(:) = arr(ind(:)) + call swiftest_util_sort_qsort_DP(tmparr, ind) + + return + end subroutine swiftest_util_sort_index_dp + + + recursive pure subroutine swiftest_util_sort_qsort_DP(arr, ind) + !! 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 + integer :: iq + + if (size(arr) > 1) then + if (present(ind)) then + call swiftest_util_sort_partition_DP(arr, iq, ind) + call swiftest_util_sort_qsort_DP(arr(:iq-1),ind(:iq-1)) + call swiftest_util_sort_qsort_DP(arr(iq:), ind(iq:)) + else + call swiftest_util_sort_partition_DP(arr, iq) + call swiftest_util_sort_qsort_DP(arr(:iq-1)) + call swiftest_util_sort_qsort_DP(arr(iq:)) + end if + end if + + return + end subroutine swiftest_util_sort_qsort_DP + + + pure subroutine swiftest_util_sort_partition_DP(arr, marker, ind) + !! author: David A. Minton + !! + !! Partition function for quicksort on DP type + !! + implicit none + ! Arguments + real(DP), intent(inout), dimension(:) :: arr + integer(I4B), intent(inout), dimension(:), optional :: ind + integer(I4B), intent(out) :: marker + ! Internals + integer(I4B) :: i, j, itmp, narr, ipiv + real(DP) :: temp + real(DP) :: x ! pivot point + + narr = size(arr) + + ! Get center as pivot, as this is likely partially sorted + ipiv = narr / 2 + x = arr(ipiv) + i = 0 + j = narr + 1 + + do + j = j - 1 + do + if (arr(j) <= x) exit + j = j - 1 + end do + i = i + 1 + do + if (arr(i) >= x) exit + i = i + 1 + end do + if (i < j) then + ! exchange A(i) and A(j) + temp = arr(i) + arr(i) = arr(j) + arr(j) = temp + if (present(ind)) then + itmp = ind(i) + ind(i) = ind(j) + ind(j) = itmp + end if + else if (i == j) then + marker = i + 1 + return + else + marker = i + return + endif + end do + + return + end subroutine swiftest_util_sort_partition_DP + + + pure module subroutine swiftest_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) + !! + implicit none + ! Arguments + integer(I4B), dimension(:), intent(inout) :: arr + + call swiftest_util_sort_qsort_I4B(arr) + + return + end subroutine swiftest_util_sort_i4b + + + pure module subroutine swiftest_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. + !! + implicit none + ! Arguments + integer(I4B), dimension(:), intent(in) :: arr + integer(I4B), dimension(:), allocatable, intent(inout) :: ind + ! Internals + integer(I4B) :: n, i + integer(I4B), dimension(:), allocatable :: tmparr + + n = size(arr) + if (.not.allocated(ind)) then + allocate(ind(n)) + ind = [(i, i=1, n)] + end if + allocate(tmparr, mold=arr) + tmparr(:) = arr(ind(:)) + call swiftest_util_sort_qsort_I4B(tmparr, ind) + + return + end subroutine swiftest_util_sort_index_I4B + + + pure module subroutine swiftest_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. + !! + implicit none + ! Arguments + integer(I4B), dimension(:), intent(in) :: arr + integer(I8B), dimension(:), allocatable, intent(inout) :: ind + ! Internals + integer(I8B) :: n, i + integer(I4B), dimension(:), allocatable :: tmparr + + n = size(arr) + if (.not.allocated(ind)) then + allocate(ind(n)) + ind = [(i, i=1_I8B, n)] + end if + allocate(tmparr, mold=arr) + tmparr(:) = arr(ind(:)) + call swiftest_util_sort_qsort_I4B_I8Bind(tmparr, ind) + + return + end subroutine swiftest_util_sort_index_I4B_I8Bind + + + recursive pure subroutine swiftest_util_sort_qsort_I4B(arr, ind) + !! 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 + integer(I4B), dimension(:), intent(out), optional :: ind + ! Internals + integer(I4B) :: iq + + if (size(arr) > 1) then + if (present(ind)) then + call swiftest_util_sort_partition_I4B(arr, iq, ind) + call swiftest_util_sort_qsort_I4B(arr(:iq-1),ind(:iq-1)) + call swiftest_util_sort_qsort_I4B(arr(iq:), ind(iq:)) + else + call swiftest_util_sort_partition_I4B(arr, iq) + call swiftest_util_sort_qsort_I4B(arr(:iq-1)) + call swiftest_util_sort_qsort_I4B(arr(iq:)) + end if + end if + + return + end subroutine swiftest_util_sort_qsort_I4B + + + recursive pure subroutine swiftest_util_sort_qsort_I4B_I8Bind(arr, ind) + !! 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 + integer(I8B), dimension(:), intent(out), optional :: ind + ! Internals + integer(I8B) :: iq + + if (size(arr) > 1_I8B) then + if (present(ind)) then + call swiftest_util_sort_partition_I4B_I8Bind(arr, iq, ind) + call swiftest_util_sort_qsort_I4B_I8Bind(arr(:iq-1_I8B),ind(:iq-1_I8B)) + call swiftest_util_sort_qsort_I4B_I8Bind(arr(iq:), ind(iq:)) + else + call swiftest_util_sort_partition_I4B_I8Bind(arr, iq) + call swiftest_util_sort_qsort_I4B_I8Bind(arr(:iq-1_I8B)) + call swiftest_util_sort_qsort_I4B_I8Bind(arr(iq:)) + end if + end if + + return + end subroutine swiftest_util_sort_qsort_I4B_I8Bind + + + recursive pure subroutine swiftest_util_sort_qsort_I8B_I8Bind(arr, ind) + !! 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 + integer(I8B), dimension(:), intent(out), optional :: ind + ! Internals + integer(I8B) :: iq + + if (size(arr) > 1_I8B) then + if (present(ind)) then + call swiftest_util_sort_partition_I8B_I8Bind(arr, iq, ind) + call swiftest_util_sort_qsort_I8B_I8Bind(arr(:iq-1_I8B),ind(:iq-1_I8B)) + call swiftest_util_sort_qsort_I8B_I8Bind(arr(iq:), ind(iq:)) + else + call swiftest_util_sort_partition_I8B_I8Bind(arr, iq) + call swiftest_util_sort_qsort_I8B_I8Bind(arr(:iq-1_I8B)) + call swiftest_util_sort_qsort_I8B_I8Bind(arr(iq:)) + end if + end if + + return + end subroutine swiftest_util_sort_qsort_I8B_I8Bind + + + pure subroutine swiftest_util_sort_partition_I4B(arr, marker, ind) + !! author: David A. Minton + !! + !! Partition function for quicksort on I4B type + !! + implicit none + ! Arguments + integer(I4B), intent(inout), dimension(:) :: arr + integer(I4B), intent(inout), dimension(:), optional :: ind + integer(I4B), intent(out) :: marker + ! Internals + integer(I4B) :: i, j, itmp, narr, ipiv + integer(I4B) :: temp + integer(I4B) :: x ! pivot point + + narr = size(arr) + + ! Get center as pivot, as this is likely partially sorted + ipiv = narr / 2 + x = arr(ipiv) + i = 0 + j = narr + 1 + + do + j = j - 1 + do + if (arr(j) <= x) exit + j = j - 1 + end do + i = i + 1 + do + if (arr(i) >= x) exit + i = i + 1 + end do + if (i < j) then + ! exchange A(i) and A(j) + temp = arr(i) + arr(i) = arr(j) + arr(j) = temp + if (present(ind)) then + itmp = ind(i) + ind(i) = ind(j) + ind(j) = itmp + end if + else if (i == j) then + marker = i + 1 + return + else + marker = i + return + endif + end do + + return + end subroutine swiftest_util_sort_partition_I4B + + + pure subroutine swiftest_util_sort_partition_I4B_I8Bind(arr, marker, ind) + !! author: David A. Minton + !! + !! Partition function for quicksort on I4B type + !! + implicit none + ! Arguments + integer(I4B), intent(inout), dimension(:) :: arr + integer(I8B), intent(inout), dimension(:), optional :: ind + integer(I8B), intent(out) :: marker + ! Internals + integer(I8B) :: i, j, itmp, narr, ipiv + integer(I4B) :: temp + integer(I8B) :: x ! pivot point + + narr = size(arr) + + ! Get center as pivot, as this is likely partially sorted + ipiv = narr / 2_I8B + x = arr(ipiv) + i = 0_I8B + j = narr + 1_I8B + + do + j = j - 1_I8B + do + if (arr(j) <= x) exit + j = j - 1_I8B + end do + i = i + 1_I8B + do + if (arr(i) >= x) exit + i = i + 1_I8B + end do + if (i < j) then + ! exchange A(i) and A(j) + temp = arr(i) + arr(i) = arr(j) + arr(j) = temp + if (present(ind)) then + itmp = ind(i) + ind(i) = ind(j) + ind(j) = itmp + end if + else if (i == j) then + marker = i + 1_I8B + return + else + marker = i + return + endif + end do + + return + end subroutine swiftest_util_sort_partition_I4B_I8Bind + + + pure subroutine swiftest_util_sort_partition_I8B_I8Bind(arr, marker, ind) + !! author: David A. Minton + !! + !! Partition function for quicksort on I8B type with I8B index + !! + implicit none + ! Arguments + integer(I8B), intent(inout), dimension(:) :: arr + integer(I8B), intent(inout), dimension(:), optional :: ind + integer(I8B), intent(out) :: marker + ! Internals + integer(I8B) :: i, j, itmp, narr, ipiv + integer(I8B) :: temp + integer(I8B) :: x ! pivot point + + narr = size(arr) + + ! Get center as pivot, as this is likely partially sorted + ipiv = narr / 2_I8B + x = arr(ipiv) + i = 0_I8B + j = narr + 1_I8B + + do + j = j - 1_I8B + do + if (arr(j) <= x) exit + j = j - 1_I8B + end do + i = i + 1_I8B + do + if (arr(i) >= x) exit + i = i + 1_I8B + end do + if (i < j) then + ! exchange A(i) and A(j) + temp = arr(i) + arr(i) = arr(j) + arr(j) = temp + if (present(ind)) then + itmp = ind(i) + ind(i) = ind(j) + ind(j) = itmp + end if + else if (i == j) then + marker = i + 1_I8B + return + else + marker = i + return + endif + end do + + return + end subroutine swiftest_util_sort_partition_I8B_I8Bind + + + pure module subroutine swiftest_util_sort_sp(arr) + !! 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 + + call swiftest_util_sort_qsort_SP(arr) + + return + end subroutine swiftest_util_sort_sp + + + pure module subroutine swiftest_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. + !! + implicit none + ! Arguments + real(SP), dimension(:), intent(in) :: arr + integer(I4B), dimension(:), allocatable, intent(inout) :: ind + ! Internals + integer(I4B) :: n, i + real(SP), dimension(:), allocatable :: tmparr + + n = size(arr) + if (.not.allocated(ind)) then + allocate(ind(n)) + ind = [(i, i=1, n)] + end if + allocate(tmparr, mold=arr) + tmparr(:) = arr(ind(:)) + call swiftest_util_sort_qsort_SP(tmparr, ind) + + return + end subroutine swiftest_util_sort_index_sp + + + recursive pure subroutine swiftest_util_sort_qsort_SP(arr, ind) + !! 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 + integer :: iq + + if (size(arr) > 1) then + if (present(ind)) then + call swiftest_util_sort_partition_SP(arr, iq, ind) + call swiftest_util_sort_qsort_SP(arr(:iq-1),ind(:iq-1)) + call swiftest_util_sort_qsort_SP(arr(iq:), ind(iq:)) + else + call swiftest_util_sort_partition_SP(arr, iq) + call swiftest_util_sort_qsort_SP(arr(:iq-1)) + call swiftest_util_sort_qsort_SP(arr(iq:)) + end if + end if + + return + end subroutine swiftest_util_sort_qsort_SP + + + pure subroutine swiftest_util_sort_partition_SP(arr, marker, ind) + !! author: David A. Minton + !! + !! Partition function for quicksort on SP type + !! + implicit none + ! Arguments + real(SP), intent(inout), dimension(:) :: arr + integer(I4B), intent(inout), dimension(:), optional :: ind + integer(I4B), intent(out) :: marker + ! Internals + integer(I4B) :: i, j, itmp, narr, ipiv + real(SP) :: temp + real(SP) :: x ! pivot point + + narr = size(arr) + + ! Get center as pivot, as this is likely partially sorted + ipiv = narr / 2 + x = arr(ipiv) + i = 0 + j = narr + 1 + + do + j = j - 1 + do + if (arr(j) <= x) exit + j = j - 1 + end do + i = i + 1 + do + if (arr(i) >= x) exit + i = i + 1 + end do + if (i < j) then + ! exchange A(i) and A(j) + temp = arr(i) + arr(i) = arr(j) + arr(j) = temp + if (present(ind)) then + itmp = ind(i) + ind(i) = ind(j) + ind(j) = itmp + end if + else if (i == j) then + marker = i + 1 + return + else + marker = i + return + endif + end do + + return + end subroutine swiftest_util_sort_partition_SP + + + module subroutine swiftest_util_sort_pl(self, sortby, ascending) + !! author: David A. Minton + !! + !! Sort a Swiftest massive body object in-place. + !! sortby is a string indicating which array component to sort. + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest 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 + + if (self%nbody == 0) return + + if (ascending) then + direction = 1 + else + direction = -1 + end if + + associate(pl => self, npl => self%nbody) + select case(sortby) + case("Gmass","mass") + call swiftest_util_sort(direction * pl%Gmass(1:npl), ind) + case("rhill") + call swiftest_util_sort(direction * pl%rhill(1:npl), ind) + case("renc") + call swiftest_util_sort(direction * pl%renc(1:npl), ind) + case("radius") + call swiftest_util_sort(direction * pl%radius(1:npl), ind) + case("density") + call swiftest_util_sort(direction * pl%density(1:npl), ind) + case("k2") + call swiftest_util_sort(direction * pl%k2(1:npl), ind) + case("Q") + call swiftest_util_sort(direction * pl%Q(1:npl), ind) + case("tlag") + call swiftest_util_sort(direction * pl%tlag(1:npl), ind) + case("nplenc") + call swiftest_util_sort(direction * pl%nplenc(1:npl), ind) + case("ntpenc") + call swiftest_util_sort(direction * pl%ntpenc(1:npl), ind) + case("lmtiny", "nplm", "nplplm", "kin", "rbeg", "rend", "vbeg", "Ip", "rot", "k_plpl", "nplpl") + write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' + case default ! Look for components in the parent class + call swiftest_util_sort_body(pl, sortby, ascending) + return + end select + + call pl%rearrange(ind) + + end associate + + return + end subroutine swiftest_util_sort_pl + + + module subroutine swiftest_util_sort_tp(self, sortby, ascending) + !! author: David A. Minton + !! + !! Sort a Swiftest test particle object in-place. + !! sortby is a string indicating which array component to sort. + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest 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 + + if (self%nbody == 0) return + + if (ascending) then + direction = 1 + else + direction = -1 + end if + + associate(tp => self, ntp => self%nbody) + select case(sortby) + case("nplenc") + call swiftest_util_sort(direction * tp%nplenc(1:ntp), ind) + case default ! Look for components in the parent class + call swiftest_util_sort_body(tp, sortby, ascending) + return + end select + + call tp%rearrange(ind) + + end associate + + return + end subroutine swiftest_util_sort_tp + + + module subroutine swiftest_util_sort_rearrange_body(self, ind) + !! author: David A. Minton + !! + !! Rearrange Swiftest body structure in-place from an index list. + !! This is a helper utility used to make polymorphic sorting work on Swiftest structures. + implicit none + ! Arguments + 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) + + associate(n => self%nbody) + call swiftest_util_sort_rearrange(self%id, ind, n) + call swiftest_util_sort_rearrange(self%lmask, ind, n) + call swiftest_util_sort_rearrange(self%info, ind, n) + call swiftest_util_sort_rearrange(self%status, ind, n) + call swiftest_util_sort_rearrange(self%ldiscard, ind, n) + call swiftest_util_sort_rearrange(self%lcollision, ind, n) + call swiftest_util_sort_rearrange(self%lencounter, ind, n) + call swiftest_util_sort_rearrange(self%rh, ind, n) + call swiftest_util_sort_rearrange(self%vh, ind, n) + call swiftest_util_sort_rearrange(self%rb, ind, n) + call swiftest_util_sort_rearrange(self%vb, ind, n) + call swiftest_util_sort_rearrange(self%ah, ind, n) + call swiftest_util_sort_rearrange(self%aobl, ind, n) + call swiftest_util_sort_rearrange(self%agr, ind, n) + call swiftest_util_sort_rearrange(self%atide, ind, n) + call swiftest_util_sort_rearrange(self%ir3h, ind, n) + call swiftest_util_sort_rearrange(self%isperi, ind, n) + call swiftest_util_sort_rearrange(self%peri, ind, n) + call swiftest_util_sort_rearrange(self%atp, ind, n) + call swiftest_util_sort_rearrange(self%mu, ind, n) + call swiftest_util_sort_rearrange(self%a, ind, n) + call swiftest_util_sort_rearrange(self%e, ind, n) + call swiftest_util_sort_rearrange(self%inc, ind, n) + call swiftest_util_sort_rearrange(self%capom, ind, n) + call swiftest_util_sort_rearrange(self%omega, ind, n) + call swiftest_util_sort_rearrange(self%capm, ind, n) + end associate + + return + end subroutine swiftest_util_sort_rearrange_body + + + pure module subroutine swiftest_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. + 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 + ! Internals + 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) + tmp(1:n) = arr(ind) + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_sort_rearrange_arr_char_string + + + pure module subroutine swiftest_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. + 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 + ! Internals + 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) + tmp(1:n) = arr(ind) + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_sort_rearrange_arr_DP + + + pure module subroutine swiftest_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. + 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 + ! Internals + 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) + tmp(:,1:n) = arr(:, ind) + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_sort_rearrange_arr_DPvec + + + pure module subroutine swiftest_util_sort_rearrange_arr_I4B(arr, ind, n) + !! 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 + ! Internals + 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) + tmp(1:n) = arr(ind) + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_sort_rearrange_arr_I4B + + pure module subroutine swiftest_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. + 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 + ! Internals + 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) + tmp(1:n) = arr(ind) + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_sort_rearrange_arr_I4B_I8Bind + + + module subroutine swiftest_util_sort_rearrange_arr_info(arr, ind, n) + !! author: David A. Minton + !! + !! Rearrange a single array of particle information type in-place from an index list. + implicit none + ! Arguments + 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 + ! Internals + type(swiftest_particle_info), dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation + + if (.not. allocated(arr) .or. n <= 0) return + allocate(tmp, mold=arr) + + call swiftest_util_copy_particle_info_arr(arr, tmp, ind) + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_sort_rearrange_arr_info + + + pure module subroutine swiftest_util_sort_rearrange_arr_kin(arr, ind, n) + !! author: David A. Minton + !! + !! Rearrange a single array of particle kinship type in-place from an index list. + implicit none + ! Arguments + 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 + ! Internals + type(swiftest_kinship), dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation + integer(I4B) :: i,j + + if (.not. allocated(arr) .or. n <= 0) return + allocate(tmp, source=arr) + tmp(1:n) = arr(ind(1:n)) + + do i = 1, n + do j = 1, tmp(i)%nchild + tmp(i)%child(j) = ind(tmp(i)%child(j)) + end do + end do + + call move_alloc(tmp, arr) + return + end subroutine swiftest_util_sort_rearrange_arr_kin + + + pure module subroutine swiftest_util_sort_rearrange_arr_logical(arr, ind, n) + !! 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 + ! Internals + logical, dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation + + if (.not. allocated(arr) .or. n <= 0) return + allocate(tmp, mold=arr) + tmp(1:n) = arr(ind) + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_sort_rearrange_arr_logical + + + pure module subroutine swiftest_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. + 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 + ! Internals + logical, dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation + + if (.not. allocated(arr) .or. n <= 0) return + allocate(tmp, mold=arr) + tmp(1:n) = arr(ind) + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_sort_rearrange_arr_logical_I8Bind + + + module subroutine swiftest_util_sort_rearrange_pl(self, ind) + !! author: David A. Minton + !! + !! Rearrange Swiftest massive body structure in-place from an index list. + !! This is a helper utility used to make polymorphic sorting work on Swiftest structures. + 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) + + associate(pl => self, npl => self%nbody) + call swiftest_util_sort_rearrange(pl%mass, ind, npl) + call swiftest_util_sort_rearrange(pl%Gmass, ind, npl) + call swiftest_util_sort_rearrange(pl%rhill, ind, npl) + call swiftest_util_sort_rearrange(pl%renc, ind, npl) + call swiftest_util_sort_rearrange(pl%radius, ind, npl) + call swiftest_util_sort_rearrange(pl%density, ind, npl) + call swiftest_util_sort_rearrange(pl%rbeg, ind, npl) + call swiftest_util_sort_rearrange(pl%vbeg, ind, npl) + call swiftest_util_sort_rearrange(pl%Ip, ind, npl) + call swiftest_util_sort_rearrange(pl%rot, ind, npl) + call swiftest_util_sort_rearrange(pl%k2, ind, npl) + call swiftest_util_sort_rearrange(pl%Q, ind, npl) + call swiftest_util_sort_rearrange(pl%tlag, ind, npl) + call swiftest_util_sort_rearrange(pl%kin, ind, npl) + call swiftest_util_sort_rearrange(pl%lmtiny, ind, npl) + call swiftest_util_sort_rearrange(pl%nplenc, ind, npl) + call swiftest_util_sort_rearrange(pl%ntpenc, ind, npl) + + if (allocated(pl%k_plpl)) deallocate(pl%k_plpl) + + call swiftest_util_sort_rearrange_body(pl, ind) + end associate + + return + end subroutine swiftest_util_sort_rearrange_pl + + + module subroutine swiftest_util_sort_rearrange_tp(self, ind) + !! author: David A. Minton + !! + !! Rearrange Swiftest massive body structure in-place from an index list. + !! This is a helper utility used to make polymorphic sorting work on Swiftest structures. + implicit none + ! Arguments + 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) + + associate(tp => self, ntp => self%nbody) + call swiftest_util_sort_rearrange(tp%nplenc, ind, ntp) + + if (allocated(tp%k_pltp)) deallocate(tp%k_pltp) + + call swiftest_util_sort_rearrange_body(tp, ind) + end associate + + return + end subroutine swiftest_util_sort_rearrange_tp + + + module subroutine swiftest_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 + 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 + ! Internals + integer(I4B) :: nspill, nkeep, nlist + character(len=STRMAX), dimension(:), allocatable :: tmp !! Array of values to keep + + nkeep = count(.not.lspill_list(:)) + nspill = count(lspill_list(:)) + nlist = size(lspill_list(:)) + + if (.not.allocated(keeps) .or. nspill == 0) return + if (.not.allocated(discards)) then + allocate(discards(nspill)) + else if (size(discards) /= nspill) then + deallocate(discards) + allocate(discards(nspill)) + end if + + discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) + if (ldestructive) then + if (nkeep > 0) then + allocate(tmp(nkeep)) + tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) + call move_alloc(tmp, keeps) + else + deallocate(keeps) + end if + end if + + return + end subroutine swiftest_util_spill_arr_char_string + + + module subroutine swiftest_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 + 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 + ! Internals + integer(I4B) :: nspill, nkeep, nlist + real(DP), dimension(:), allocatable :: tmp !! Array of values to keep + + nkeep = count(.not.lspill_list(:)) + nspill = count(lspill_list(:)) + nlist = size(lspill_list(:)) + + if (.not.allocated(keeps) .or. nspill == 0) return + if (.not.allocated(discards)) then + allocate(discards(nspill)) + else if (size(discards) /= nspill) then + deallocate(discards) + allocate(discards(nspill)) + end if + + discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) + if (ldestructive) then + if (nkeep > 0) then + allocate(tmp(nkeep)) + tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) + call move_alloc(tmp, keeps) + else + deallocate(keeps) + end if + end if + + return + end subroutine swiftest_util_spill_arr_DP + + + module subroutine swiftest_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 + 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 + ! Internals + integer(I4B) :: i, nspill, nkeep, nlist + real(DP), dimension(:,:), allocatable :: tmp !! Array of values to keep + + nkeep = count(.not.lspill_list(:)) + nspill = count(lspill_list(:)) + nlist = size(lspill_list(:)) + + if (.not.allocated(keeps) .or. nspill == 0) return + if (.not.allocated(discards)) then + allocate(discards(NDIM, nspill)) + else if (size(discards, dim=2) /= nspill) then + deallocate(discards) + allocate(discards(NDIM, nspill)) + end if + + do i = 1, NDIM + discards(i,:) = pack(keeps(i,1:nlist), lspill_list(1:nlist)) + end do + if (ldestructive) then + if (nkeep > 0) then + allocate(tmp(NDIM, nkeep)) + do i = 1, NDIM + tmp(i, :) = pack(keeps(i, 1:nlist), .not. lspill_list(1:nlist)) + end do + call move_alloc(tmp, keeps) + else + deallocate(keeps) + end if + end if + + return + end subroutine swiftest_util_spill_arr_DPvec + + + module subroutine swiftest_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 + 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 + ! Internals + integer(I4B) :: nspill, nkeep, nlist + integer(I4B), dimension(:), allocatable :: tmp !! Array of values to keep + + nkeep = count(.not.lspill_list(:)) + nspill = count(lspill_list(:)) + nlist = size(lspill_list(:)) + + if (.not.allocated(keeps) .or. nspill == 0) return + if (.not.allocated(discards)) then + allocate(discards(nspill)) + else if (size(discards) /= nspill) then + deallocate(discards) + allocate(discards(nspill)) + end if + + discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) + if (ldestructive) then + if (nkeep > 0) then + allocate(tmp(nkeep)) + tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) + call move_alloc(tmp, keeps) + else + deallocate(keeps) + end if + end if + + return + end subroutine swiftest_util_spill_arr_I4B + + + module subroutine swiftest_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 + 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 + ! Internals + integer(I4B) :: nspill, nkeep, nlist + integer(I8B), dimension(:), allocatable :: tmp !! Array of values to keep + + nkeep = count(.not.lspill_list(:)) + nspill = count(lspill_list(:)) + nlist = size(lspill_list(:)) + + if (.not.allocated(keeps) .or. nspill == 0) return + if (.not.allocated(discards)) then + allocate(discards(nspill)) + else if (size(discards) /= nspill) then + deallocate(discards) + allocate(discards(nspill)) + end if + + discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) + if (ldestructive) then + if (nkeep > 0) then + allocate(tmp(nkeep)) + tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) + call move_alloc(tmp, keeps) + else + deallocate(keeps) + end if + end if + + return + end subroutine swiftest_util_spill_arr_I8B + + + module subroutine swiftest_util_spill_arr_info(keeps, discards, lspill_list, ldestructive) + !! author: David A. Minton + !! + !! Performs a spill operation on a single array of particle origin information types + !! This is the inverse of a spill operation + implicit none + ! Arguments + 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 + ! Internals + integer(I4B) :: i, nspill, nkeep, nlist + integer(I4B), dimension(:), allocatable :: idx + type(swiftest_particle_info), dimension(:), allocatable :: tmp + + nkeep = count(.not.lspill_list(:)) + nspill = count(lspill_list(:)) + nlist = size(lspill_list(:)) + + if (.not.allocated(keeps) .or. nspill == 0) return + if (.not.allocated(discards)) then + allocate(discards(nspill)) + else if (size(discards) /= nspill) then + deallocate(discards) + allocate(discards(nspill)) + end if + + allocate(idx(nspill)) + idx(:) = pack([(i, i = 1, nlist)], lspill_list) + call swiftest_util_copy_particle_info_arr(keeps, discards, idx) + if (ldestructive) then + if (nkeep > 0) then + deallocate(idx) + allocate(idx(nkeep)) + allocate(tmp(nkeep)) + idx(:) = pack([(i, i = 1, nlist)], .not. lspill_list) + call swiftest_util_copy_particle_info_arr(keeps, tmp, idx) + call move_alloc(tmp, keeps) + else + deallocate(keeps) + end if + end if + + return + end subroutine swiftest_util_spill_arr_info + + + module subroutine swiftest_util_spill_arr_kin(keeps, discards, lspill_list, ldestructive) + !! author: David A. Minton + !! + !! Performs a spill operation on a single array of particle kinships + !! This is the inverse of a spill operation + implicit none + ! Arguments + 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 + ! Internals + integer(I4B) :: nspill, nkeep, nlist + type(swiftest_kinship), dimension(:), allocatable :: tmp + + nkeep = count(.not.lspill_list(:)) + nspill = count(lspill_list(:)) + nlist = size(lspill_list(:)) + + if (.not.allocated(keeps) .or. nspill == 0) return + if (.not.allocated(discards)) then + allocate(discards(nspill)) + else if (size(discards) /= nspill) then + deallocate(discards) + allocate(discards(nspill)) + end if + + discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) + if (ldestructive) then + if (nkeep > 0) then + allocate(tmp(nkeep)) + tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) + call move_alloc(tmp, keeps) + else + deallocate(keeps) + end if + end if + + return + end subroutine swiftest_util_spill_arr_kin + + + module subroutine swiftest_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 + 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 + ! Internals + integer(I4B) :: nspill, nkeep, nlist + logical, dimension(:), allocatable :: tmp !! Array of values to keep + + nkeep = count(.not.lspill_list(:)) + nspill = count(lspill_list(:)) + nlist = size(lspill_list(:)) + + if (.not.allocated(keeps) .or. nspill == 0) return + if (.not.allocated(discards)) then + allocate(discards(nspill)) + else if (size(discards) /= nspill) then + deallocate(discards) + allocate(discards(nspill)) + end if + + discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) + if (ldestructive) then + if (nkeep > 0) then + allocate(tmp(nkeep)) + tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) + call move_alloc(tmp, keeps) + else + deallocate(keeps) + end if + end if + + return + end subroutine swiftest_util_spill_arr_logical + + + module subroutine swiftest_util_spill_body(self, discards, lspill_list, ldestructive) + !! author: David A. Minton + !! + !! Move spilled (discarded) Swiftest generic particle structure from active list to discard list + !! Adapted from David E. Kaufmann's Swifter routine whm_discard_spill.f90 + implicit none + ! Arguments + class(swiftest_body), intent(inout) :: self !! Swiftest generic 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 + ! Internals + integer(I4B) :: nbody_old + + ! 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) + + call swiftest_util_spill(keeps%id, discards%id, lspill_list, ldestructive) + call swiftest_util_spill(keeps%info, discards%info, lspill_list, ldestructive) + call swiftest_util_spill(keeps%lmask, discards%lmask, lspill_list, ldestructive) + call swiftest_util_spill(keeps%status, discards%status, lspill_list, ldestructive) + call swiftest_util_spill(keeps%ldiscard, discards%ldiscard, lspill_list, ldestructive) + call swiftest_util_spill(keeps%lcollision, discards%lcollision, lspill_list, ldestructive) + call swiftest_util_spill(keeps%lencounter, discards%lencounter, lspill_list, ldestructive) + call swiftest_util_spill(keeps%mu, discards%mu, lspill_list, ldestructive) + call swiftest_util_spill(keeps%rh, discards%rh, lspill_list, ldestructive) + call swiftest_util_spill(keeps%vh, discards%vh, lspill_list, ldestructive) + call swiftest_util_spill(keeps%rb, discards%rb, lspill_list, ldestructive) + call swiftest_util_spill(keeps%vb, discards%vb, lspill_list, ldestructive) + call swiftest_util_spill(keeps%ah, discards%ah, lspill_list, ldestructive) + call swiftest_util_spill(keeps%aobl, discards%aobl, lspill_list, ldestructive) + call swiftest_util_spill(keeps%agr, discards%agr, lspill_list, ldestructive) + call swiftest_util_spill(keeps%atide, discards%atide, lspill_list, ldestructive) + call swiftest_util_spill(keeps%ir3h, discards%ir3h, lspill_list, ldestructive) + call swiftest_util_spill(keeps%isperi, discards%isperi, lspill_list, ldestructive) + call swiftest_util_spill(keeps%peri, discards%peri, lspill_list, ldestructive) + call swiftest_util_spill(keeps%atp, discards%atp, lspill_list, ldestructive) + call swiftest_util_spill(keeps%a, discards%a, lspill_list, ldestructive) + call swiftest_util_spill(keeps%e, discards%e, lspill_list, ldestructive) + call swiftest_util_spill(keeps%inc, discards%inc, lspill_list, ldestructive) + call swiftest_util_spill(keeps%capom, discards%capom, lspill_list, ldestructive) + call swiftest_util_spill(keeps%omega, discards%omega, lspill_list, ldestructive) + call swiftest_util_spill(keeps%capm, discards%capm, lspill_list, ldestructive) + + nbody_old = keeps%nbody + + ! This is the base class, so will be the last to be called in the cascade. + ! Therefore we need to set the nbody values for both the keeps and discareds + discards%nbody = count(lspill_list(1:nbody_old)) + if (ldestructive) keeps%nbody = nbody_old- discards%nbody + end associate + + return + end subroutine swiftest_util_spill_body + + + module subroutine swiftest_util_spill_pl(self, discards, lspill_list, ldestructive) + !! author: David A. Minton + !! + !! Move spilled (discarded) Swiftest massive body structure from active list to discard list + !! Adapted from David E. Kaufmann's Swifter routine whm_discard_spill.f90 + implicit none + ! Arguments + 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 body by removing the discard list + + associate(keeps => self) + select type (discards) ! The standard requires us to select the type of both arguments in order to access all the components + class is (swiftest_pl) + !> Spill components specific to the massive body class + call swiftest_util_spill(keeps%mass, discards%mass, lspill_list, ldestructive) + call swiftest_util_spill(keeps%Gmass, discards%Gmass, lspill_list, ldestructive) + call swiftest_util_spill(keeps%rhill, discards%rhill, lspill_list, ldestructive) + call swiftest_util_spill(keeps%renc, discards%renc, lspill_list, ldestructive) + call swiftest_util_spill(keeps%radius, discards%radius, lspill_list, ldestructive) + call swiftest_util_spill(keeps%density, discards%density, lspill_list, ldestructive) + call swiftest_util_spill(keeps%rbeg, discards%rbeg, lspill_list, ldestructive) + call swiftest_util_spill(keeps%rend, discards%rend, lspill_list, ldestructive) + call swiftest_util_spill(keeps%vbeg, discards%vbeg, lspill_list, ldestructive) + call swiftest_util_spill(keeps%Ip, discards%Ip, lspill_list, ldestructive) + call swiftest_util_spill(keeps%rot, discards%rot, lspill_list, ldestructive) + call swiftest_util_spill(keeps%k2, discards%k2, lspill_list, ldestructive) + call swiftest_util_spill(keeps%Q, discards%Q, lspill_list, ldestructive) + call swiftest_util_spill(keeps%tlag, discards%tlag, lspill_list, ldestructive) + call swiftest_util_spill(keeps%kin, discards%kin, lspill_list, ldestructive) + call swiftest_util_spill(keeps%lmtiny, discards%lmtiny, lspill_list, ldestructive) + call swiftest_util_spill(keeps%nplenc, discards%nplenc, lspill_list, ldestructive) + call swiftest_util_spill(keeps%ntpenc, discards%ntpenc, lspill_list, ldestructive) + + if (ldestructive .and. allocated(keeps%k_plpl)) deallocate(keeps%k_plpl) + + call swiftest_util_spill_body(keeps, discards, lspill_list, ldestructive) + class default + write(*,*) 'Error! spill method called for incompatible return type on swiftest_pl' + end select + end associate + + return + end subroutine swiftest_util_spill_pl + + + module subroutine swiftest_util_spill_tp(self, discards, lspill_list, ldestructive) + !! author: David A. Minton + !! + !! Move spilled (discarded) Swiftest test particle structure from active list to discard list + !! Adapted from David E. Kaufmann's Swifter routine whm_discard_spill.f90 + implicit none + ! Arguments + 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 discardse + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter body by removing the discard list + + associate(keeps => self, ntp => self%nbody) + select type(discards) + class is (swiftest_tp) + !> Spill components specific to the test particle class + call swiftest_util_spill(keeps%nplenc, discards%nplenc, lspill_list, ldestructive) + call swiftest_util_spill_body(keeps, discards, lspill_list, ldestructive) + class default + write(*,*) 'Error! spill method called for incompatible return type on swiftest_tp' + end select + end associate + + return + end subroutine swiftest_util_spill_tp + + + module subroutine swiftest_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) + 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) + ! Internals + real(DP), dimension(:), allocatable :: unique_array + integer(I4B) :: n + real(DP) :: lo, hi + + allocate(unique_array, mold=input_array) + allocate(index_map(size(input_array))) + lo = minval(input_array) - 1 + hi = maxval(input_array) + + n = 0 + do + n = n + 1 + lo = minval(input_array(:), mask=input_array(:) > lo) + unique_array(n) = lo + where(input_array(:) == lo) index_map(:) = n + if (lo >= hi) exit + enddo + allocate(output_array(n), source=unique_array(1:n)) + + return + end subroutine swiftest_util_unique_DP + + + module subroutine swiftest_util_unique_I4B(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 (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) + ! Internals + integer(I4B), dimension(:), allocatable :: unique_array + integer(I4B) :: n, lo, hi + + allocate(unique_array, mold=input_array) + allocate(index_map, mold=input_array) + lo = minval(input_array) - 1 + hi = maxval(input_array) + + n = 0 + do + n = n + 1 + lo = minval(input_array(:), mask=input_array(:) > lo) + unique_array(n) = lo + where(input_array(:) == lo) index_map(:) = n + if (lo >= hi) exit + enddo + allocate(output_array(n), source=unique_array(1:n)) + + return + end subroutine swiftest_util_unique_I4B + + + module subroutine swiftest_util_valid_id_system(self, param) + !! author: David A. Minton + !! + !! Validate massive body and test particle ids + !! subroutine swiftest_causes program to exit with error if any ids are not unique + !! + !! Adapted from David E. Kaufmann's Swifter routine: util_valid.f90 + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i + integer(I4B), dimension(:), allocatable :: idarr + + associate(cb => self%cb, pl => self%pl, npl => self%pl%nbody, tp => self%tp, ntp => self%tp%nbody) + allocate(idarr(1+npl+ntp)) + idarr(1) = cb%id + do i = 1, npl + idarr(1+i) = pl%id(i) + end do + do i = 1, ntp + idarr(1+npl+i) = tp%id(i) + end do + call swiftest_util_sort(idarr) + do i = 1, npl + ntp + if (idarr(i) == idarr(i+1)) then + write(*, *) "Swiftest error:" + write(*, *) " more than one body/particle has id = ", idarr(i) + call util_exit(FAILURE) + end if + end do + param%maxid = max(param%maxid, maxval(idarr)) + end associate + + return + end subroutine swiftest_util_valid_id_system + + + module subroutine swiftest_util_version() + !! author: David A. Minton + !! + !! Print program version information to terminale + !! + !! Adapted from David E. Kaufmann's Swifter routine: util_version.f90 + implicit none + write(*, 200) VERSION_NUMBER + 200 format(/, "************* Swiftest: Version ", f3.1, " *************", //, & + "Based off of Swifter:", //, & + "Authors:", //, & + " The Purdue University Swiftest Development team ", /, & + " Lead by David A. Minton ", /, & + " Single loop blocking by Jacob R. Elliott", /, & + " Fragmentation by Carlisle A. Wishard and", //, & + " Jennifer L. L. Poutplin ", //, & + "Please address comments and questions to:", //, & + " David A. Minton", /, & + " Department Earth, Atmospheric, & Planetary Sciences ",/, & + " Purdue University", /, & + " 550 Stadium Mall Drive", /, & + " West Lafayette, Indiana 47907", /, & + " 765-250-8034 ", /, & + " daminton@purdue.edu", /, & + "Special thanks to Hal Levison and Martin Duncan for the original",/,& + "SWIFTER and SWIFT codes that made this possible.", //, & + "************************************************", /) + + + 100 FORMAT(/, "************* SWIFTER: Version ", F3.1, " *************", //, & + "Authors:", //, & + " Martin Duncan: Queen's University", /, & + " Hal Levison : Southwest Research Institute", //, & + "Please address comments and questions to:", //, & + " Hal Levison or David Kaufmann", /, & + " Department of Space Studies", /, & + " Southwest Research Institute", /, & + " 1050 Walnut Street, Suite 400", /, & + " Boulder, Colorado 80302", /, & + " 303-546-0290 (HFL), 720-240-0119 (DEK)", /, & + " 303-546-9687 (fax)", /, & + " hal@gort.boulder.swri.edu (HFL)", /, & + " kaufmann@boulder.swri.edu (DEK)", //, & + "************************************************", /) + + return + end subroutine swiftest_util_version + +end submodule s_swiftest_util \ No newline at end of file diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 deleted file mode 100644 index 1423adc7e..000000000 --- a/src/symba/symba_collision.f90 +++ /dev/null @@ -1,1091 +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. - -submodule (symba_classes) s_symba_collision - use swiftest - -contains - - module function symba_collision_casedisruption(system, param, colliders, frag) result(status) - !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Create the fragments resulting from a non-catastrophic disruption collision - !! - implicit none - ! Arguments - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object - ! Result - integer(I4B) :: status !! Status flag assigned to this outcome - ! Internals - integer(I4B) :: i, nfrag - logical :: lfailure - character(len=STRMAX) :: message - - select case(frag%regime) - case(COLLRESOLVE_REGIME_DISRUPTION) - message = "Disruption between" - case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - message = "Supercatastrophic disruption between" - end select - call symba_collision_collider_message(system%pl, colliders%idx, message) - call io_log_one_message(FRAGGLE_LOG_OUT, message) - - ! Collisional fragments will be uniformly distributed around the pre-impact barycenter - call frag%set_mass_dist(colliders, param) - - ! Generate the position and velocity distributions of the fragments - call frag%generate_fragments(colliders, system, param, lfailure) - - if (lfailure) then - call io_log_one_message(FRAGGLE_LOG_OUT, "No fragment solution found, so treat as a pure hit-and-run") - status = ACTIVE - nfrag = 0 - select type(pl => system%pl) - class is (symba_pl) - pl%status(colliders%idx(:)) = status - pl%ldiscard(colliders%idx(:)) = .false. - pl%lcollision(colliders%idx(:)) = .false. - end select - else - ! Populate the list of new bodies - nfrag = frag%nbody - write(message, *) nfrag - call io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") - select case(frag%regime) - case(COLLRESOLVE_REGIME_DISRUPTION) - status = DISRUPTION - case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - status = SUPERCATASTROPHIC - end select - frag%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] - param%maxid = frag%id(nfrag) - call symba_collision_mergeaddsub(system, param, colliders, frag, status) - end if - - return - end function symba_collision_casedisruption - - - module function symba_collision_casehitandrun(system, param, colliders, frag) result(status) - !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Create the fragments resulting from a non-catastrophic hit-and-run collision - !! - implicit none - ! Arguments - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object - ! Result - integer(I4B) :: status !! Status flag assigned to this outcom - ! Internals - integer(I4B) :: i, ibiggest, nfrag, jtarg, jproj - logical :: lpure - character(len=STRMAX) :: message - - message = "Hit and run between" - call symba_collision_collider_message(system%pl, colliders%idx, message) - call io_log_one_message(FRAGGLE_LOG_OUT, trim(adjustl(message))) - - if (colliders%mass(1) > colliders%mass(2)) then - jtarg = 1 - jproj = 2 - else - jtarg = 2 - jproj = 1 - end if - - if (frag%mass_dist(2) > 0.9_DP * colliders%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched - call io_log_one_message(FRAGGLE_LOG_OUT, "Pure hit and run. No new fragments generated.") - nfrag = 0 - lpure = .true. - else ! Imperfect hit and run, so we'll keep the largest body and destroy the other - lpure = .false. - call frag%set_mass_dist(colliders, param) - - ! Generate the position and velocity distributions of the fragments - call frag%generate_fragments(colliders, system, param, lpure) - - if (lpure) then - call io_log_one_message(FRAGGLE_LOG_OUT, "Should have been a pure hit and run instead") - nfrag = 0 - else - nfrag = frag%nbody - write(message, *) nfrag - call io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") - end if - end if - if (lpure) then ! Reset these bodies back to being active so that nothing further is done to them - status = HIT_AND_RUN_PURE - select type(pl => system%pl) - class is (symba_pl) - pl%status(colliders%idx(:)) = ACTIVE - pl%ldiscard(colliders%idx(:)) = .false. - pl%lcollision(colliders%idx(:)) = .false. - end select - else - ibiggest = colliders%idx(maxloc(system%pl%Gmass(colliders%idx(:)), dim=1)) - frag%id(1) = system%pl%id(ibiggest) - frag%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] - param%maxid = frag%id(nfrag) - status = HIT_AND_RUN_DISRUPT - call symba_collision_mergeaddsub(system, param, colliders, frag, status) - end if - - return - end function symba_collision_casehitandrun - - - module function symba_collision_casemerge(system, param, colliders, frag) result(status) - !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Merge massive bodies. - !! - !! Adapted from David E. Kaufmann's Swifter routines symba_merge_pl.f90 and symba_discard_merge_pl.f90 - !! - !! Adapted from Hal Levison's Swift routines symba5_merge.f and discard_mass_merge.f - implicit none - ! Arguments - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object - ! Result - integer(I4B) :: status !! Status flag assigned to this outcome - ! Internals - integer(I4B) :: i, j, k, ibiggest - real(DP) :: pe - real(DP), dimension(NDIM) :: L_spin_new - character(len=STRMAX) :: message - - message = "Merging" - call symba_collision_collider_message(system%pl, colliders%idx, message) - call io_log_one_message(FRAGGLE_LOG_OUT, message) - - select type(pl => system%pl) - class is (symba_pl) - - call frag%set_mass_dist(colliders, param) - ibiggest = colliders%idx(maxloc(pl%Gmass(colliders%idx(:)), dim=1)) - frag%id(1) = pl%id(ibiggest) - frag%xb(:,1) = frag%xbcom(:) - frag%vb(:,1) = frag%vbcom(:) - - if (param%lrotation) then - ! Conserve angular momentum by putting pre-impact orbital momentum into spin of the new body - L_spin_new(:) = colliders%L_orbit(:,1) + colliders%L_orbit(:,2) + colliders%L_spin(:,1) + colliders%L_spin(:,2) - - ! Assume prinicpal axis rotation on 3rd Ip axis - frag%rot(:,1) = L_spin_new(:) / (frag%Ip(3,1) * frag%mass(1) * frag%radius(1)**2) - else ! If spin is not enabled, we will consider the lost pre-collision angular momentum as "escaped" and add it to our bookkeeping variable - param%Lescape(:) = param%Lescape(:) + colliders%L_orbit(:,1) + colliders%L_orbit(:,2) - end if - - ! Keep track of the component of potential energy due to the pre-impact colliders%idx for book-keeping - pe = 0.0_DP - do j = 1, colliders%ncoll - do i = j + 1, colliders%ncoll - pe = pe - pl%Gmass(i) * pl%mass(j) / norm2(pl%xb(:, i) - pl%xb(:, j)) - end do - end do - system%Ecollisions = system%Ecollisions + pe - system%Euntracked = system%Euntracked - pe - - ! Update any encounter lists that have the removed bodies in them so that they instead point to the new - do k = 1, system%plplenc_list%nenc - do j = 1, colliders%ncoll - i = colliders%idx(j) - if (i == ibiggest) cycle - if (system%plplenc_list%id1(k) == pl%id(i)) then - system%plplenc_list%id1(k) = pl%id(ibiggest) - system%plplenc_list%index1(k) = i - end if - if (system%plplenc_list%id2(k) == pl%id(i)) then - system%plplenc_list%id2(k) = pl%id(ibiggest) - system%plplenc_list%index2(k) = i - end if - if (system%plplenc_list%id1(k) == system%plplenc_list%id2(k)) system%plplenc_list%status(k) = INACTIVE - end do - end do - - status = MERGED - - call symba_collision_mergeaddsub(system, param, colliders, frag, status) - - end select - - return - end function symba_collision_casemerge - - - subroutine symba_collision_collider_message(pl, collidx, collider_message) - !! author: David A. Minton - !! - !! Prints a nicely formatted message about which bodies collided, including their names and ids. - !! This subroutine appends the body names and ids to an input message. - implicit none - ! Arguments - class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object - integer(I4B), dimension(:), intent(in) :: collidx !! Index of collisional colliders%idx members - character(*), intent(inout) :: collider_message !! The message to print to the screen. - ! Internals - integer(I4B) :: i, n - character(len=STRMAX) :: idstr - - n = size(collidx) - if (n == 0) return - - do i = 1, n - if (i > 1) collider_message = trim(adjustl(collider_message)) // " and " - collider_message = " " // trim(adjustl(collider_message)) // " " // trim(adjustl(pl%info(collidx(i))%name)) - write(idstr, '(I10)') pl%id(collidx(i)) - collider_message = trim(adjustl(collider_message)) // " (" // trim(adjustl(idstr)) // ") " - end do - - return - end subroutine symba_collision_collider_message - - - module function symba_collision_check_encounter(self, system, param, t, dt, irec) result(lany_collision) - !! author: David A. Minton - !! - !! Check for merger between massive bodies and test particles in SyMBA - !! - !! Adapted from David E. Kaufmann's Swifter routine symba_merge.f90 and symba_merge_tp.f90 - !! - !! Adapted from Hal Levison's Swift routine symba5_merge.f - implicit none - ! Arguments - class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: 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 - ! Result - logical :: 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 - integer(I4B) :: i, j, k, nenc - real(DP) :: rlim, Gmtot - logical :: isplpl - character(len=STRMAX) :: timestr, idstri, idstrj, message - class(symba_encounter), allocatable :: tmp - - lany_collision = .false. - if (self%nenc == 0) return - - select type(self) - class is (symba_plplenc) - isplpl = .true. - class default - isplpl = .false. - end select - - select type(pl => system%pl) - class is (symba_pl) - select type(tp => system%tp) - class is (symba_tp) - nenc = self%nenc - allocate(lmask(nenc)) - lmask(:) = ((self%status(1:nenc) == ACTIVE) .and. (pl%levelg(self%index1(1:nenc)) >= irec)) - if (isplpl) then - lmask(:) = lmask(:) .and. (pl%levelg(self%index2(1:nenc)) >= irec) - else - lmask(:) = lmask(:) .and. (tp%levelg(self%index2(1:nenc)) >= irec) - end if - if (.not.any(lmask(:))) return - - allocate(lcollision(nenc)) - lcollision(:) = .false. - - if (isplpl) then - do concurrent(k = 1:nenc, lmask(k)) - i = self%index1(k) - j = self%index2(k) - xr(:) = pl%xh(:, i) - pl%xh(:, j) - vr(:) = pl%vb(:, i) - pl%vb(:, j) - rlim = pl%radius(i) + pl%radius(j) - Gmtot = pl%Gmass(i) + pl%Gmass(j) - lcollision(k) = symba_collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), & - Gmtot, rlim, dt, self%lvdotr(k)) - end do - else - do concurrent(k = 1:nenc, lmask(k)) - i = self%index1(k) - j = self%index2(k) - xr(:) = pl%xh(:, i) - tp%xh(:, j) - vr(:) = pl%vb(:, i) - tp%vb(:, j) - lcollision(k) = symba_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)) - end do - end if - - lany_collision = any(lcollision(:)) - if (lany_collision) then - call pl%xh2xb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary - do k = 1, nenc - i = self%index1(k) - j = self%index2(k) - if (lcollision(k)) self%status(k) = COLLISION - self%t(k) = t - self%x1(:,k) = pl%xh(:,i) + system%cb%xb(:) - self%v1(:,k) = pl%vb(:,i) - if (isplpl) then - self%x2(:,k) = pl%xh(:,j) + system%cb%xb(:) - 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 collisional colliders%idx - if (pl%lcollision(i) .or. pl%lcollision(j)) call pl%make_colliders([i,j]) - - ! 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]) = COLLISION - call pl%info(i)%set_value(status="COLLISION", discard_time=t, discard_xh=pl%xh(:,i), discard_vh=pl%vh(:,i)) - call pl%info(j)%set_value(status="COLLISION", discard_time=t, discard_xh=pl%xh(:,j), discard_vh=pl%vh(:,j)) - end if - else - self%x2(:,k) = tp%xh(:,j) + system%cb%xb(:) - self%v2(:,k) = tp%vb(:,j) - if (lcollision(k)) then - tp%status(j) = DISCARDED_PLR - tp%ldiscard(j) = .true. - write(idstri, *) pl%id(i) - write(idstrj, *) tp%id(j) - write(timestr, *) t - call tp%info(j)%set_value(status="DISCARDED_PLR", discard_time=t, discard_xh=tp%xh(:,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)) - call io_log_one_message(FRAGGLE_LOG_OUT, message) - end if - end if - end do - end if - end select - end select - - ! Extract the pl-pl or pl-tp encounter list and return the pl-pl or pl-tp collision_list - if (lany_collision) then - select type(self) - class is (symba_plplenc) - call self%extract_collisions(system, param) - class default - allocate(tmp, mold=self) - call self%spill(tmp, lcollision, ldestructive=.true.) ! Remove this encounter pair from the encounter list - end select - end if - - return - end function symba_collision_check_encounter - - - pure elemental function symba_collision_check_one(xr, yr, zr, vxr, vyr, vzr, Gmtot, rlim, dt, lvdotr) result(lcollision) - !! author: David A. Minton - !! - !! Check for a merger between a single pair of particles - !! - !! Adapted from David E. Kaufmann's Swifter routines symba_merge_tp.f90 and symba_merge_pl.f90 - !! - !! Adapted from Hal Levison's Swift routine symba5_merge.f - implicit none - ! Arguments - real(DP), intent(in) :: xr, yr, zr !! Relative position vector components - real(DP), intent(in) :: vxr, vyr, vzr !! Relative velocity vector components - real(DP), intent(in) :: Gmtot !! Sum of G*mass of colliding bodies - real(DP), intent(in) :: rlim !! Collision limit - Typically the sum of the radii of colliding bodies - real(DP), intent(in) :: dt !! Step size - logical, intent(in) :: lvdotr !! Logical flag indicating that these two bodies are approaching in the current substep - ! Result - logical :: lcollision !! Logical flag indicating whether these two bodies will collide or not - ! Internals - real(DP) :: r2, rlim2, a, e, q, vdotr, tcr2, dt2 - - r2 = xr**2 + yr**2 + zr**2 - rlim2 = rlim**2 - - 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 - lcollision = .false. - vdotr = xr * vxr + yr * vyr + zr * vzr - if (lvdotr .and. (vdotr > 0.0_DP)) then - tcr2 = r2 / (vxr**2 + vyr**2 + vzr**2) - dt2 = dt**2 - if (tcr2 <= dt2) then - call orbel_xv2aeq(Gmtot, xr, yr, zr, vxr, vyr, vzr, a, e, q) - lcollision = (q < rlim) - end if - end if - end if - - return - end function symba_collision_check_one - - - function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, colliders) result(lflag) - !! author: David A. Minton - !! - !! Loops through the pl-pl collision list and groups families together by index. Outputs the indices of all colliders%idx 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(symba_pl), intent(inout) :: pl !! SyMBA massive body object - class(symba_cb), intent(inout) :: cb !! SyMBA central body object - class(symba_parameters), intent(in) :: param !! Current run configuration parameters with SyMBA additions - integer(I4B), dimension(2), intent(inout) :: idx_parent !! Index of the two bodies considered the "parents" of the collision - class(fraggle_colliders), intent(out) :: colliders - ! Result - logical :: lflag !! Logical flag indicating whether a colliders%idx was successfully created or not - ! Internals - type collidx_array - integer(I4B), dimension(:), allocatable :: id - integer(I4B), dimension(:), allocatable :: idx - end type collidx_array - type(collidx_array), dimension(2) :: parent_child_index_array - integer(I4B), dimension(2) :: nchild - integer(I4B) :: i, j, ncolliders, idx_child - real(DP), dimension(2) :: volume, density - real(DP) :: mchild, volchild - real(DP), dimension(NDIM) :: xc, vc, xcom, vcom, xchild, vchild, xcrossv - real(DP), dimension(NDIM,2) :: mxc, vcc - - nchild(:) = pl%kin(idx_parent(:))%nchild - ! 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) - lflag = .false. - call pl%reset_kinship([idx_parent(1)]) - return - end if - idx_parent(2) = pl%kin(idx_parent(1))%child(nchild(1)) - nchild(1) = nchild(1) - 1 - nchild(2) = 0 - pl%kin(idx_parent(:))%nchild = nchild(:) - pl%kin(idx_parent(2))%parent = idx_parent(1) - end if - - colliders%mass(:) = pl%mass(idx_parent(:)) ! Note: This is meant to mass, not G*mass, as the collisional regime determination uses mass values that will be converted to Si - colliders%radius(:) = pl%radius(idx_parent(:)) - volume(:) = (4.0_DP / 3.0_DP) * PI * colliders%radius(:)**3 - - ! Group together the ids and indexes of each collisional parent and its children - do j = 1, 2 - allocate(parent_child_index_array(j)%idx(nchild(j)+ 1)) - allocate(parent_child_index_array(j)%id(nchild(j)+ 1)) - associate(idx_arr => parent_child_index_array(j)%idx, & - id_arr => parent_child_index_array(j)%id, & - ncj => nchild(j), & - pl => pl, & - plkinj => pl%kin(idx_parent(j))) - idx_arr(1) = idx_parent(j) - if (ncj > 0) idx_arr(2:ncj + 1) = plkinj%child(1:ncj) - id_arr(:) = pl%id(idx_arr(:)) - end associate - end do - - ! Consolidate the groups of collsional parents with any children they may have into a single "colliders%idx" index array - ncolliders = 2 + sum(nchild(:)) - allocate(colliders%idx(ncolliders)) - colliders%idx = [parent_child_index_array(1)%idx(:),parent_child_index_array(2)%idx(:)] - - colliders%ncoll = count(pl%lcollision(colliders%idx(:))) - colliders%idx = pack(colliders%idx(:), pl%lcollision(colliders%idx(:))) - colliders%L_spin(:,:) = 0.0_DP - colliders%Ip(:,:) = 0.0_DP - - ! Find the barycenter of each body along with its children, if it has any - do j = 1, 2 - colliders%xb(:, j) = pl%xh(:, idx_parent(j)) + cb%xb(:) - colliders%vb(:, j) = pl%vb(:, idx_parent(j)) - ! Assume principal axis rotation about axis corresponding to highest moment of inertia (3rd Ip) - if (param%lrotation) then - colliders%Ip(:, j) = colliders%mass(j) * pl%Ip(:, idx_parent(j)) - colliders%L_spin(:, j) = colliders%Ip(3, j) * colliders%radius(j)**2 * pl%rot(:, idx_parent(j)) - end if - - if (nchild(j) > 0) then - do i = 1, nchild(j) ! Loop over all children and take the mass weighted mean of the properties - idx_child = parent_child_index_array(j)%idx(i + 1) - if (.not. pl%lcollision(idx_child)) cycle - mchild = pl%mass(idx_child) - xchild(:) = pl%xh(:, idx_child) + cb%xb(:) - vchild(:) = pl%vb(:, idx_child) - volchild = (4.0_DP / 3.0_DP) * PI * pl%radius(idx_child)**3 - volume(j) = volume(j) + volchild - ! Get angular momentum of the child-parent pair and add that to the spin - ! Add the child's spin - if (param%lrotation) then - xcom(:) = (colliders%mass(j) * colliders%xb(:,j) + mchild * xchild(:)) / (colliders%mass(j) + mchild) - vcom(:) = (colliders%mass(j) * colliders%vb(:,j) + mchild * vchild(:)) / (colliders%mass(j) + mchild) - xc(:) = colliders%xb(:, j) - xcom(:) - vc(:) = colliders%vb(:, j) - vcom(:) - xcrossv(:) = xc(:) .cross. vc(:) - colliders%L_spin(:, j) = colliders%L_spin(:, j) + colliders%mass(j) * xcrossv(:) - - xc(:) = xchild(:) - xcom(:) - vc(:) = vchild(:) - vcom(:) - xcrossv(:) = xc(:) .cross. vc(:) - colliders%L_spin(:, j) = colliders%L_spin(:, j) + mchild * xcrossv(:) - - colliders%L_spin(:, j) = colliders%L_spin(:, j) + mchild * pl%Ip(3, idx_child) & - * pl%radius(idx_child)**2 & - * pl%rot(:, idx_child) - colliders%Ip(:, j) = colliders%Ip(:, j) + mchild * pl%Ip(:, idx_child) - end if - - ! Merge the child and parent - colliders%mass(j) = colliders%mass(j) + mchild - colliders%xb(:, j) = xcom(:) - colliders%vb(:, j) = vcom(:) - end do - end if - density(j) = colliders%mass(j) / volume(j) - colliders%radius(j) = (3 * volume(j) / (4 * PI))**(1.0_DP / 3.0_DP) - if (param%lrotation) colliders%Ip(:, j) = colliders%Ip(:, j) / colliders%mass(j) - end do - lflag = .true. - - xcom(:) = (colliders%mass(1) * colliders%xb(:, 1) + colliders%mass(2) * colliders%xb(:, 2)) / sum(colliders%mass(:)) - vcom(:) = (colliders%mass(1) * colliders%vb(:, 1) + colliders%mass(2) * colliders%vb(:, 2)) / sum(colliders%mass(:)) - mxc(:, 1) = colliders%mass(1) * (colliders%xb(:, 1) - xcom(:)) - mxc(:, 2) = colliders%mass(2) * (colliders%xb(:, 2) - xcom(:)) - vcc(:, 1) = colliders%vb(:, 1) - vcom(:) - vcc(:, 2) = colliders%vb(:, 2) - vcom(:) - colliders%L_orbit(:,:) = mxc(:,:) .cross. vcc(:,:) - - ! Destroy the kinship relationships for all members of this colliders%idx - call pl%reset_kinship(colliders%idx(:)) - - return - end function symba_collision_consolidate_colliders - - - module subroutine symba_collision_encounter_extract_collisions(self, system, param) - !! author: David A. Minton - !! - !! Processes the pl-pl encounter list remove only those encounters that led to a collision - !! - implicit none - ! Arguments - class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - ! Internals - logical, dimension(:), allocatable :: lplpl_collision - logical, dimension(:), allocatable :: lplpl_unique_parent - integer(I4B), dimension(:), pointer :: plparent - integer(I4B), dimension(:), allocatable :: collision_idx, unique_parent_idx - integer(I4B) :: i, index_coll, ncollisions, nunique_parent, nplplenc - - select type (pl => system%pl) - class is (symba_pl) - associate(plplenc_list => self, idx1 => self%index1, idx2 => self%index2, plparent => pl%kin%parent) - nplplenc = plplenc_list%nenc - allocate(lplpl_collision(nplplenc)) - lplpl_collision(:) = plplenc_list%status(1:nplplenc) == COLLISION - if (.not.any(lplpl_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-pl encounters that lead to a collision - ncollisions = count(lplpl_collision(:)) - allocate(collision_idx(ncollisions)) - collision_idx = pack([(i, i=1, nplplenc)], lplpl_collision) - - ! Get the subset of collisions that involve a unique pair of parents - allocate(lplpl_unique_parent(ncollisions)) - - lplpl_unique_parent(:) = plparent(idx1(collision_idx(:))) /= plparent(idx2(collision_idx(:))) - nunique_parent = count(lplpl_unique_parent(:)) - allocate(unique_parent_idx(nunique_parent)) - 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 - ! due to restructuring of parent/child relationships when there are large numbers of multi-body collisions in a single - ! step - lplpl_unique_parent(:) = .true. - do index_coll = 1, ncollisions - associate(ip1 => plparent(idx1(collision_idx(index_coll))), ip2 => plparent(idx2(collision_idx(index_coll)))) - lplpl_unique_parent(:) = .not. ( any(plparent(idx1(unique_parent_idx(:))) == ip1) .or. & - any(plparent(idx2(unique_parent_idx(:))) == ip1) .or. & - any(plparent(idx1(unique_parent_idx(:))) == ip2) .or. & - any(plparent(idx2(unique_parent_idx(:))) == ip2) ) - 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. - 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 plplenc_list%spill(system%plplcollision_list, lplpl_collision, ldestructive=.true.) ! Extract any encounters that are not collisions from the list. - end associate - end select - - return - end subroutine symba_collision_encounter_extract_collisions - - - module subroutine symba_collision_make_colliders_pl(self, idx) - !! author: Jennifer L.L. Pouplin, Carlisle A. wishard, and David A. Minton - !! - !! When a single body is involved in more than one collision in a single step, it becomes part of a colliders%idx. - !! The largest body involved in a multi-body collision is the "parent" and all bodies that collide with it are its "children," - !! including those that collide with the children. - !! - !! Adapted from David E. Kaufmann's Swifter routine symba_merge_pl.f90 - !! - !! Adapted from Hal Levison's Swift routine symba5_merge.f - implicit none - ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - integer(I4B), dimension(2), intent(in) :: idx !! Array holding the indices of the two bodies involved in the collision - ! Internals - integer(I4B) :: i, j, index_parent, index_child, p1, p2 - integer(I4B) :: nchild_inherit, nchild_orig, nchild_new - integer(I4B), dimension(:), allocatable :: temp - - associate(pl => self) - p1 = pl%kin(idx(1))%parent - p2 = pl%kin(idx(2))%parent - if (p1 == p2) return ! This is a collision between to children of a shared parent. We will ignore it. - - if (pl%mass(p1) > pl%mass(p2)) then - index_parent = p1 - index_child = p2 - else - index_parent = p2 - index_child = p1 - end if - - ! Expand the child array (or create it if necessary) and copy over the previous lists of children - nchild_orig = pl%kin(index_parent)%nchild - nchild_inherit = pl%kin(index_child)%nchild - nchild_new = nchild_orig + nchild_inherit + 1 - allocate(temp(nchild_new)) - - if (nchild_orig > 0) temp(1:nchild_orig) = pl%kin(index_parent)%child(1:nchild_orig) - ! Find out if the child body has any children of its own. The new parent wil inherit these children - if (nchild_inherit > 0) then - temp(nchild_orig+1:nchild_orig+nchild_inherit) = pl%kin(index_child)%child(1:nchild_inherit) - do i = 1, nchild_inherit - j = pl%kin(index_child)%child(i) - ! Set the childrens' parent to the new parent - pl%kin(j)%parent = index_parent - end do - end if - call pl%reset_kinship([index_child]) - ! Add the new child to its parent - pl%kin(index_child)%parent = index_parent - temp(nchild_new) = index_child - ! Save the new child array to the parent - pl%kin(index_parent)%nchild = nchild_new - call move_alloc(from=temp, to=pl%kin(index_parent)%child) - end associate - - return - end subroutine symba_collision_make_colliders_pl - - - subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) - !! author: David A. Minton - !! - !! Fills the pl_discards and pl_adds with removed and added bodies - !! - implicit none - ! Arguments - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object - integer(I4B), intent(in) :: status !! Status flag to assign to adds - ! Internals - integer(I4B) :: i, ibiggest, ismallest, iother, nstart, nend, ncolliders, nfrag - logical, dimension(system%pl%nbody) :: lmask - class(symba_pl), allocatable :: plnew, plsub - character(*), parameter :: FRAGFMT = '("Newbody",I0.7)' - character(len=NAMELEN) :: newname - - select type(pl => system%pl) - class is (symba_pl) - select type(pl_discards => system%pl_discards) - class is (symba_merger) - associate(info => pl%info, pl_adds => system%pl_adds, cb => system%cb, npl => pl%nbody) - ! Add the colliders%idx bodies to the subtraction list - ncolliders = colliders%ncoll - nfrag = frag%nbody - - param%maxid_collision = max(param%maxid_collision, maxval(system%pl%info(:)%collision_id)) - param%maxid_collision = param%maxid_collision + 1 - - ! Setup new bodies - allocate(plnew, mold=pl) - call plnew%setup(nfrag, param) - ibiggest = colliders%idx(maxloc(pl%Gmass(colliders%idx(:)), dim=1)) - ismallest = colliders%idx(minloc(pl%Gmass(colliders%idx(:)), dim=1)) - - ! Copy over identification, information, and physical properties of the new bodies from the fragment list - plnew%id(1:nfrag) = frag%id(1:nfrag) - plnew%xb(:, 1:nfrag) = frag%xb(:, 1:nfrag) - plnew%vb(:, 1:nfrag) = frag%vb(:, 1:nfrag) - call pl%vb2vh(cb) - call pl%xh2xb(cb) - do i = 1, nfrag - plnew%xh(:,i) = frag%xb(:, i) - cb%xb(:) - plnew%vh(:,i) = frag%vb(:, i) - cb%vb(:) - end do - plnew%mass(1:nfrag) = frag%mass(1:nfrag) - plnew%Gmass(1:nfrag) = param%GU * frag%mass(1:nfrag) - plnew%radius(1:nfrag) = frag%radius(1:nfrag) - plnew%density(1:nfrag) = frag%mass(1:nfrag) / frag%radius(1:nfrag) - call plnew%set_rhill(cb) - - select case(status) - case(DISRUPTION) - plnew%status(1:nfrag) = NEW_PARTICLE - do i = 1, nfrag - write(newname, FRAGFMT) frag%id(i) - call plnew%info(i)%set_value(origin_type="Disruption", origin_time=param%t, name=newname, & - origin_xh=plnew%xh(:,i), & - origin_vh=plnew%vh(:,i), collision_id=param%maxid_collision) - end do - do i = 1, ncolliders - if (colliders%idx(i) == ibiggest) then - iother = ismallest - else - iother = ibiggest - end if - call pl%info(colliders%idx(i))%set_value(status="Disruption", discard_time=param%t, & - discard_xh=pl%xh(:,i), discard_vh=pl%vh(:,i), discard_body_id=iother) - end do - case(SUPERCATASTROPHIC) - plnew%status(1:nfrag) = NEW_PARTICLE - do i = 1, nfrag - write(newname, FRAGFMT) frag%id(i) - call plnew%info(i)%set_value(origin_type="Supercatastrophic", origin_time=param%t, name=newname, & - origin_xh=plnew%xh(:,i), origin_vh=plnew%vh(:,i), & - collision_id=param%maxid_collision) - end do - do i = 1, ncolliders - if (colliders%idx(i) == ibiggest) then - iother = ismallest - else - iother = ibiggest - end if - call pl%info(colliders%idx(i))%set_value(status="Supercatastrophic", discard_time=param%t, & - discard_xh=pl%xh(:,i), discard_vh=pl%vh(:,i), & - discard_body_id=iother) - end do - case(HIT_AND_RUN_DISRUPT) - call plnew%info(1)%copy(pl%info(ibiggest)) - plnew%status(1) = OLD_PARTICLE - do i = 2, nfrag - write(newname, FRAGFMT) frag%id(i) - call plnew%info(i)%set_value(origin_type="Hit and run fragment", origin_time=param%t, name=newname, & - origin_xh=plnew%xh(:,i), origin_vh=plnew%vh(:,i), & - collision_id=param%maxid_collision) - end do - do i = 1, ncolliders - if (colliders%idx(i) == ibiggest) cycle - iother = ibiggest - call pl%info(colliders%idx(i))%set_value(status="Hit and run fragmention", discard_time=param%t, & - discard_xh=pl%xh(:,i), discard_vh=pl%vh(:,i), & - discard_body_id=iother) - end do - case(MERGED) - call plnew%info(1)%copy(pl%info(ibiggest)) - plnew%status(1) = OLD_PARTICLE - do i = 1, ncolliders - if (colliders%idx(i) == ibiggest) cycle - - iother = ibiggest - call pl%info(colliders%idx(i))%set_value(status="MERGED", discard_time=param%t, discard_xh=pl%xh(:,i), & - discard_vh=pl%vh(:,i), discard_body_id=iother) - end do - end select - - if (param%lrotation) then - plnew%Ip(:, 1:nfrag) = frag%Ip(:, 1:nfrag) - plnew%rot(:, 1:nfrag) = frag%rot(:, 1:nfrag) - end if - - ! if (param%ltides) then - ! plnew%Q = pl%Q(ibiggest) - ! plnew%k2 = pl%k2(ibiggest) - ! plnew%tlag = pl%tlag(ibiggest) - ! end if - - !Copy over or set integration parameters for new bodies - plnew%lcollision(1:nfrag) = .false. - plnew%ldiscard(1:nfrag) = .false. - plnew%levelg(1:nfrag) = pl%levelg(ibiggest) - plnew%levelm(1:nfrag) = pl%levelm(ibiggest) - - ! Log the properties of the new bodies - call fraggle_io_log_pl(plnew, param) - - ! Append the new merged body to the list - nstart = pl_adds%nbody + 1 - nend = pl_adds%nbody + nfrag - call pl_adds%append(plnew, lsource_mask=[(.true., i=1, nfrag)]) - ! Record how many bodies were added in this event - pl_adds%ncomp(nstart:nend) = plnew%nbody - - ! Add the discarded bodies to the discard list - pl%status(colliders%idx(:)) = MERGED - pl%ldiscard(colliders%idx(:)) = .true. - pl%lcollision(colliders%idx(:)) = .true. - lmask(:) = .false. - lmask(colliders%idx(:)) = .true. - - call plnew%setup(0, param) - deallocate(plnew) - - allocate(plsub, mold=pl) - call pl%spill(plsub, lmask, ldestructive=.false.) - - nstart = pl_discards%nbody + 1 - nend = pl_discards%nbody + ncolliders - call pl_discards%append(plsub, lsource_mask=[(.true., i = 1, ncolliders)]) - - ! Record how many bodies were subtracted in this event - pl_discards%ncomp(nstart:nend) = ncolliders - - call plsub%setup(0, param) - deallocate(plsub) - end associate - end select - end select - - return - end subroutine symba_collision_mergeaddsub - - - module subroutine symba_collision_resolve_fragmentations(self, system, param) - !! author: David A. Minton - !! - !! Process list of collisions, determine the collisional regime, and then create fragments. - !! - implicit none - ! Arguments - class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - ! Internals - ! Internals - integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision - logical :: lgoodcollision - integer(I4B) :: i - type(fraggle_colliders) :: colliders !! Fraggle colliders object - type(fraggle_fragments) :: frag !! Fraggle fragmentation system object - - associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2) - select type(pl => system%pl) - class is (symba_pl) - select type (cb => system%cb) - class is (symba_cb) - do i = 1, ncollisions - idx_parent(1) = pl%kin(idx1(i))%parent - idx_parent(2) = pl%kin(idx2(i))%parent - lgoodcollision = symba_collision_consolidate_colliders(pl, cb, param, idx_parent, colliders) - if ((.not. lgoodcollision) .or. any(pl%status(idx_parent(:)) /= COLLISION)) cycle - - call colliders%regime(frag, system, param) - - select case (frag%regime) - case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - plplcollision_list%status(i) = symba_collision_casedisruption(system, param, colliders, frag) - case (COLLRESOLVE_REGIME_HIT_AND_RUN) - plplcollision_list%status(i) = symba_collision_casehitandrun(system, param, colliders, frag) - case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - plplcollision_list%status(i) = symba_collision_casemerge(system, param, colliders, frag) - case default - write(*,*) "Error in symba_collision, unrecognized collision regime" - call util_exit(FAILURE) - end select - end do - end select - end select - end associate - - return - end subroutine symba_collision_resolve_fragmentations - - - module subroutine symba_collision_resolve_mergers(self, system, param) - !! author: David A. Minton - !! - !! Process list of collisions and merge colliding bodies together. - !! - implicit none - ! Arguments - class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - ! Internals - integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision - logical :: lgoodcollision - integer(I4B) :: i - type(fraggle_colliders) :: colliders !! Fraggle colliders object - type(fraggle_fragments) :: frag !! Fraggle fragmentation system object - - associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2) - select type(pl => system%pl) - class is (symba_pl) - select type(cb => system%cb) - class is (symba_cb) - do i = 1, ncollisions - idx_parent(1) = pl%kin(idx1(i))%parent - idx_parent(2) = pl%kin(idx2(i))%parent - lgoodcollision = symba_collision_consolidate_colliders(pl, cb, param, idx_parent, colliders) - if (.not. lgoodcollision) cycle - if (any(pl%status(idx_parent(:)) /= COLLISION)) cycle ! One of these two bodies has already been resolved - - frag%regime = COLLRESOLVE_REGIME_MERGE - frag%mtot = sum(colliders%mass(:)) - frag%mass_dist(1) = frag%mtot - frag%mass_dist(2) = 0.0_DP - frag%mass_dist(3) = 0.0_DP - frag%xbcom(:) = (colliders%mass(1) * colliders%xb(:,1) + colliders%mass(2) * colliders%xb(:,2)) / frag%mtot - frag%vbcom(:) = (colliders%mass(1) * colliders%vb(:,1) + colliders%mass(2) * colliders%vb(:,2)) / frag%mtot - plplcollision_list%status(i) = symba_collision_casemerge(system, param, colliders, frag) - end do - end select - end select - end associate - - return - end subroutine symba_collision_resolve_mergers - - - module subroutine symba_collision_resolve_plplenc(self, system, param, t, dt, irec) - !! author: David A. Minton - !! - !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the collision - !! - implicit none - ! Arguments - class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Current simulation time - real(DP), intent(in) :: dt !! Current simulation step size - integer(I4B), intent(in) :: irec !! Current recursion level - ! Internals - real(DP) :: Eorbit_before, Eorbit_after - logical :: lplpl_collision - character(len=STRMAX) :: timestr - class(symba_parameters), allocatable :: tmp_param - - associate(plplenc_list => self, plplcollision_list => system%plplcollision_list) - select type(pl => system%pl) - class is (symba_pl) - select type(param) - class is (symba_parameters) - if (plplcollision_list%nenc == 0) return ! No collisions to resolve - ! Make sure that the heliocentric and barycentric coordinates are consistent with each other - call pl%vb2vh(system%cb) - call pl%xh2xb(system%cb) - - ! Get the energy before the collision is resolved - if (param%lenergy) then - call system%get_energy_and_momentum(param) - Eorbit_before = system%te - end if - - do - write(timestr,*) t - call io_log_one_message(FRAGGLE_LOG_OUT, "") - call io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & - "***********************************************************") - call io_log_one_message(FRAGGLE_LOG_OUT, "Collision between massive bodies detected at time t = " // & - trim(adjustl(timestr))) - call io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & - "***********************************************************") - allocate(tmp_param, source=param) - tmp_param%t = t - if (param%lfragmentation) then - call plplcollision_list%resolve_fragmentations(system, param) - else - call plplcollision_list%resolve_mergers(system, param) - end if - - ! Destroy the collision list now that the collisions are resolved - call plplcollision_list%setup(0_I8B) - - if ((system%pl_adds%nbody == 0) .and. (system%pl_discards%nbody == 0)) exit - - ! Save the add/discard information to file - call system%write_discard(tmp_param) - - ! Rearrange the arrays: Remove discarded bodies, add any new bodies, resort, and recompute all indices and encounter lists - call pl%rearray(system, tmp_param) - - ! Destroy the add/discard list so that we don't append the same body multiple times if another collision is detected - call system%pl_discards%setup(0, param) - call system%pl_adds%setup(0, param) - deallocate(tmp_param) - - ! Check whether or not any of the particles that were just added are themselves in a collision state. This will generate a new plplcollision_list - lplpl_collision = plplenc_list%collision_check(system, param, t, dt, irec) - - if (.not.lplpl_collision) exit - end do - - if (param%lenergy) then - call system%get_energy_and_momentum(param) - Eorbit_after = system%te - system%Ecollisions = system%Ecollisions + (Eorbit_after - Eorbit_before) - end if - - end select - end select - end associate - - return - end subroutine symba_collision_resolve_plplenc - - - module subroutine symba_collision_resolve_pltpenc(self, system, param, t, dt, irec) - !! author: David A. Minton - !! - !! Process the pl-tp collision list, then modifiy the massive bodies based on the outcome of the collision - !! - implicit none - ! Arguments - class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - 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 - - ! Make sure coordinate systems are all synced up due to being inside the recursion at this point - call system%pl%vb2vh(system%cb) - call system%tp%vb2vh(system%cb%vb) - call system%pl%b2h(system%cb) - call system%tp%b2h(system%cb) - - ! Discard the collider - call system%tp%discard(system, param) - - return - end subroutine symba_collision_resolve_pltpenc - -end submodule s_symba_collision \ No newline at end of file diff --git a/src/symba/symba_discard.f90 b/src/symba/symba_discard.f90 index f60b91a28..216ab5f28 100644 --- a/src/symba/symba_discard.f90 +++ b/src/symba/symba_discard.f90 @@ -7,11 +7,11 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (symba_classes) s_symba_discard +submodule (symba) s_symba_discard use swiftest contains - subroutine symba_discard_cb_pl(pl, system, param) + subroutine symba_discard_cb_pl(pl, nbody_system, param) !! author: David A. Minton !! !! Check to see if planets should be discarded based on their positions relative to the central body. @@ -24,75 +24,75 @@ subroutine symba_discard_cb_pl(pl, system, param) implicit none ! Arguments class(symba_pl), intent(inout) :: pl !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i real(DP) :: energy, vb2, rb2, rh2, rmin2, rmax2, rmaxu2 character(len=STRMAX) :: idstr, timestr, message - associate(npl => pl%nbody, cb => system%cb) - call system%set_msys() + associate(npl => pl%nbody, cb => nbody_system%cb) + call nbody_system%set_msys() rmin2 = param%rmin**2 rmax2 = param%rmax**2 rmaxu2 = param%rmaxu**2 do i = 1, npl if (pl%status(i) == ACTIVE) then - rh2 = dot_product(pl%xh(:,i), pl%xh(:,i)) + rh2 = dot_product(pl%rh(:,i), pl%rh(:,i)) if ((param%rmax >= 0.0_DP) .and. (rh2 > rmax2)) then pl%ldiscard(i) = .true. pl%lcollision(i) = .false. pl%status(i) = DISCARDED_RMAX write(idstr, *) pl%id(i) - write(timestr, *) param%t + write(timestr, *) nbody_system%t write(message, *) trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " too far from the central body at t = " // trim(adjustl(timestr)) - call io_log_one_message(FRAGGLE_LOG_OUT, "") - call io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "***********************************************************" // & "***********************************************************") - call io_log_one_message(FRAGGLE_LOG_OUT, message) - call io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "***********************************************************" // & "***********************************************************") - call io_log_one_message(FRAGGLE_LOG_OUT, "") - call pl%info(i)%set_value(status="DISCARDED_RMAX", discard_time=param%t, discard_xh=pl%xh(:,i), & + 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)) else if ((param%rmin >= 0.0_DP) .and. (rh2 < rmin2)) then pl%ldiscard(i) = .true. pl%lcollision(i) = .false. pl%status(i) = DISCARDED_RMIN write(idstr, *) pl%id(i) - write(timestr, *) param%t + write(timestr, *) nbody_system%t write(message, *) trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " too close to the central body at t = " // trim(adjustl(timestr)) - call io_log_one_message(FRAGGLE_LOG_OUT, "") - call io_log_one_message(FRAGGLE_LOG_OUT, "************************************************************" // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "************************************************************" // & "************************************************************") - call io_log_one_message(FRAGGLE_LOG_OUT, message) - call io_log_one_message(FRAGGLE_LOG_OUT, "************************************************************" // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "************************************************************" // & "************************************************************") - call io_log_one_message(FRAGGLE_LOG_OUT, "") - call pl%info(i)%set_value(status="DISCARDED_RMIN", discard_time=param%t, discard_xh=pl%xh(:,i), & + 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) else if (param%rmaxu >= 0.0_DP) then - rb2 = dot_product(pl%xb(:,i), pl%xb(:,i)) + rb2 = dot_product(pl%rb(:,i), pl%rb(:,i)) vb2 = dot_product(pl%vb(:,i), pl%vb(:,i)) - energy = 0.5_DP * vb2 - system%Gmtot / sqrt(rb2) + energy = 0.5_DP * vb2 - nbody_system%Gmtot / sqrt(rb2) if ((energy > 0.0_DP) .and. (rb2 > rmaxu2)) then pl%ldiscard(i) = .true. pl%lcollision(i) = .false. pl%status(i) = DISCARDED_RMAXU write(idstr, *) pl%id(i) - write(timestr, *) param%t + write(timestr, *) nbody_system%t write(message, *) trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " is unbound and too far from barycenter at t = " // trim(adjustl(timestr)) - call io_log_one_message(FRAGGLE_LOG_OUT, "") - call io_log_one_message(FRAGGLE_LOG_OUT, "************************************************************" // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "************************************************************" // & "************************************************************") - call io_log_one_message(FRAGGLE_LOG_OUT, message) - call io_log_one_message(FRAGGLE_LOG_OUT, "************************************************************" // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "************************************************************" // & "************************************************************") - call io_log_one_message(FRAGGLE_LOG_OUT, "") - call pl%info(i)%set_value(status="DISCARDED_RMAXU", discard_time=param%t, discard_xh=pl%xh(:,i), & + 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)) end if end if @@ -104,27 +104,28 @@ subroutine symba_discard_cb_pl(pl, system, param) end subroutine symba_discard_cb_pl - subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) + subroutine symba_discard_conserve_mtm(pl, nbody_system, param, ipl, lescape_body) !! author: David A. Minton !! - !! Conserves system momentum when a body is lost from the system or collides with central body + !! Conserves nbody_system momentum when a body is lost from the nbody_system or collides with central body implicit none ! Arguments class(symba_pl), intent(inout) :: pl - class(symba_nbody_system), intent(inout) :: system - class(symba_parameters), intent(inout) :: param + class(symba_nbody_system), intent(inout) :: nbody_system + class(swiftest_parameters), intent(inout) :: param integer(I4B), intent(in) :: ipl logical, intent(in) :: lescape_body ! Internals real(DP), dimension(NDIM) :: Lpl, Ltot, Lcb, xcom, vcom - real(DP) :: pe, ke_orbit, ke_spin + real(DP) :: pe, be, ke_orbit, ke_spin integer(I4B) :: i, oldstat - select type(cb => system%cb) + select type(cb => nbody_system%cb) class is (symba_cb) - ! Add the potential and kinetic energy of the lost body to the records - pe = -cb%Gmass * pl%mass(ipl) / norm2(pl%xb(:, ipl) - cb%xb(:)) + ! Add the potential, binding, and kinetic energy of the lost body to the records + pe = -cb%Gmass * pl%mass(ipl) / norm2(pl%rb(:, ipl) - cb%rb(:)) + be = -3*pl%Gmass(ipl) * pl%mass(ipl) / (5 * pl%radius(ipl)) ke_orbit = 0.5_DP * pl%mass(ipl) * dot_product(pl%vb(:, ipl), pl%vb(:, ipl)) if (param%lrotation) then ke_spin = 0.5_DP * pl%mass(ipl) * pl%radius(ipl)**2 * pl%Ip(3, ipl) * dot_product(pl%rot(:, ipl), pl%rot(:, ipl)) @@ -135,18 +136,18 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) ! Add the pre-collision ke of the central body to the records ! Add planet mass to central body accumulator if (lescape_body) then - system%GMescape = system%GMescape + pl%Gmass(ipl) + nbody_system%GMescape = nbody_system%GMescape + pl%Gmass(ipl) do i = 1, pl%nbody if (i == ipl) cycle - pe = pe - pl%Gmass(i) * pl%mass(ipl) / norm2(pl%xb(:, ipl) - pl%xb(:, i)) + pe = pe - pl%Gmass(i) * pl%mass(ipl) / norm2(pl%rb(:, ipl) - pl%rb(:, i)) end do Ltot(:) = 0.0_DP do i = 1, pl%nbody - Lpl(:) = pL%mass(i) * (pl%xb(:,i) .cross. pl%vb(:, i)) + Lpl(:) = pL%mass(i) * (pl%rb(:,i) .cross. pl%vb(:, i)) Ltot(:) = Ltot(:) + Lpl(:) end do - Ltot(:) = Ltot(:) + cb%mass * (cb%xb(:) .cross. cb%vb(:)) + Ltot(:) = Ltot(:) + cb%mass * (cb%rb(:) .cross. cb%vb(:)) call pl%b2h(cb) oldstat = pl%status(ipl) pl%status(ipl) = INACTIVE @@ -154,21 +155,21 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) pl%status(ipl) = oldstat do i = 1, pl%nbody if (i == ipl) cycle - Lpl(:) = pl%mass(i) * (pl%xb(:,i) .cross. pl%vb(:, i)) + Lpl(:) = pl%mass(i) * (pl%rb(:,i) .cross. pl%vb(:, i)) Ltot(:) = Ltot(:) - Lpl(:) end do - Ltot(:) = Ltot(:) - cb%mass * (cb%xb(:) .cross. cb%vb(:)) - system%Lescape(:) = system%Lescape(:) + Ltot(:) - if (param%lrotation) system%Lescape(:) = system%Lescape + pl%mass(ipl) * pl%radius(ipl)**2 & + Ltot(:) = Ltot(:) - cb%mass * (cb%rb(:) .cross. cb%vb(:)) + nbody_system%Lescape(:) = nbody_system%Lescape(:) + Ltot(:) + if (param%lrotation) nbody_system%Lescape(:) = nbody_system%Lescape + pl%mass(ipl) * pl%radius(ipl)**2 & * pl%Ip(3, ipl) * pl%rot(:, ipl) else - xcom(:) = (pl%mass(ipl) * pl%xb(:, ipl) + cb%mass * cb%xb(:)) / (cb%mass + pl%mass(ipl)) + xcom(:) = (pl%mass(ipl) * pl%rb(:, ipl) + cb%mass * cb%rb(:)) / (cb%mass + pl%mass(ipl)) vcom(:) = (pl%mass(ipl) * pl%vb(:, ipl) + cb%mass * cb%vb(:)) / (cb%mass + pl%mass(ipl)) - Lpl(:) = (pl%xb(:,ipl) - xcom(:)) .cross. (pL%vb(:,ipl) - vcom(:)) + Lpl(:) = (pl%rb(:,ipl) - xcom(:)) .cross. (pL%vb(:,ipl) - vcom(:)) if (param%lrotation) Lpl(:) = pl%mass(ipl) * (Lpl(:) + pl%radius(ipl)**2 * pl%Ip(3,ipl) * pl%rot(:, ipl)) - Lcb(:) = cb%mass * ((cb%xb(:) - xcom(:)) .cross. (cb%vb(:) - vcom(:))) + Lcb(:) = cb%mass * ((cb%rb(:) - xcom(:)) .cross. (cb%vb(:) - vcom(:))) ke_orbit = ke_orbit + 0.5_DP * cb%mass * dot_product(cb%vb(:), cb%vb(:)) if (param%lrotation) ke_spin = ke_spin + 0.5_DP * cb%mass * cb%radius**2 * cb%Ip(3) * dot_product(cb%rot(:), cb%rot(:)) @@ -186,7 +187,7 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) cb%rot(:) = (cb%L0(:) + cb%dL(:)) / (cb%Ip(3) * cb%mass * cb%radius**2) ke_spin = ke_spin - 0.5_DP * cb%mass * cb%radius**2 * cb%Ip(3) * dot_product(cb%rot(:), cb%rot(:)) end if - cb%xb(:) = xcom(:) + cb%rb(:) = xcom(:) cb%vb(:) = vcom(:) ke_orbit = ke_orbit - 0.5_DP * cb%mass * dot_product(cb%vb(:), cb%vb(:)) end if @@ -194,11 +195,8 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) ! We must do this for proper book-keeping, since we can no longer track this body's contribution to energy directly if (lescape_body) then - system%Ecollisions = system%Ecollisions + ke_orbit + ke_spin + pe - system%Euntracked = system%Euntracked - (ke_orbit + ke_spin + pe) - else - system%Ecollisions = system%Ecollisions + pe - system%Euntracked = system%Euntracked - pe + nbody_system%Ecollisions = nbody_system%Ecollisions + ke_orbit + ke_spin + pe + be + nbody_system%Euntracked = nbody_system%Euntracked - (ke_orbit + ke_spin + pe + be) end if end select @@ -206,7 +204,7 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) end subroutine symba_discard_conserve_mtm - subroutine symba_discard_nonplpl(pl, system, param) + subroutine symba_discard_nonplpl(pl, nbody_system, param) !! author: David A. Minton !! !! Check to see if planets should be discarded based on their positions or because they are unbound @@ -217,7 +215,7 @@ subroutine symba_discard_nonplpl(pl, system, param) implicit none ! Arguments class(symba_pl), intent(inout) :: pl !! SyMBA test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals logical, dimension(pl%nbody) :: ldiscard @@ -225,44 +223,39 @@ subroutine symba_discard_nonplpl(pl, system, param) class(symba_pl), allocatable :: plsub ! First check for collisions with the central body - associate(npl => pl%nbody, cb => system%cb) + associate(npl => pl%nbody, cb => nbody_system%cb, pl_discards => nbody_system%pl_discards) if (npl == 0) return - select type(pl_discards => system%pl_discards) - class is (symba_merger) - if ((param%rmin >= 0.0_DP) .or. (param%rmax >= 0.0_DP) .or. (param%rmaxu >= 0.0_DP)) then - call symba_discard_cb_pl(pl, system, param) - end if - if (param%qmin >= 0.0_DP) call symba_discard_peri_pl(pl, 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)]) - - ! Record how many bodies were subtracted in this event - pl_discards%ncomp(nstart:nend) = nsub - end if - end select + if ((param%rmin >= 0.0_DP) .or. (param%rmax >= 0.0_DP) .or. (param%rmaxu >= 0.0_DP)) then + 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 end subroutine symba_discard_nonplpl - subroutine symba_discard_nonplpl_conservation(pl, system, param) + subroutine symba_discard_nonplpl_conservation(pl, nbody_system, param) !! author: David A. Minton !! !! If there are any bodies that are removed due to either colliding with the central body or escaping the systme, - !! we need to track the conserved quantities with the system bookkeeping terms. + !! we need to track the conserved quantities with the nbody_system bookkeeping terms. implicit none ! Arguments class(symba_pl), intent(inout) :: pl !! SyMBA test particle object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, ndiscard, dstat logical :: lescape @@ -284,7 +277,7 @@ subroutine symba_discard_nonplpl_conservation(pl, system, param) cycle end if ! Conserve all the quantities - call symba_discard_conserve_mtm(pl, system, param, discard_index_list(i), lescape) + call symba_discard_conserve_mtm(pl, nbody_system, param, discard_index_list(i), lescape) end do end associate @@ -292,7 +285,7 @@ subroutine symba_discard_nonplpl_conservation(pl, system, param) end subroutine symba_discard_nonplpl_conservation - subroutine symba_discard_peri_pl(pl, system, param) + subroutine symba_discard_peri_pl(pl, nbody_system, param) !! author: David A. Minton !! !! Check to see if a test particle should be discarded because its perihelion distance becomes too small @@ -302,7 +295,7 @@ subroutine symba_discard_peri_pl(pl, system, param) implicit none ! Arguments class(symba_pl), intent(inout) :: pl !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals logical, save :: lfirst = .true. @@ -314,10 +307,10 @@ subroutine symba_discard_peri_pl(pl, system, param) lfirst_orig = pl%lfirst pl%lfirst = lfirst if (lfirst) then - call pl%get_peri(system, param) + call pl%get_peri(nbody_system, param) lfirst = .false. else - call pl%get_peri(system, param) + call pl%get_peri(nbody_system, param) do i = 1, pl%nbody if (pl%status(i) == ACTIVE) then if ((pl%isperi(i) == 0) .and. (pl%nplenc(i)== 0)) then @@ -325,12 +318,12 @@ subroutine symba_discard_peri_pl(pl, system, param) pl%ldiscard(i) = .true. pl%lcollision(i) = .false. pl%status(i) = DISCARDED_PERI - write(timestr, *) param%t + write(timestr, *) nbody_system%t write(idstr, *) pl%id(i) write(*, *) trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstr)) // & ") perihelion distance too small at t = " // trim(adjustl(timestr)) - call pl%info(i)%set_value(status="DISCARDED_PERI", discard_time=param%t, & - discard_xh=pl%xh(:,i), discard_vh=pl%vh(:,i), discard_body_id=system%cb%id) + call pl%info(i)%set_value(status="DISCARDED_PERI", discard_time=nbody_system%t, & + discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), discard_body_id=nbody_system%cb%id) end if end if end if @@ -342,47 +335,47 @@ subroutine symba_discard_peri_pl(pl, system, param) end subroutine symba_discard_peri_pl - module subroutine symba_discard_pl(self, system, param) + 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 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 - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals real(DP) :: Eorbit_before, Eorbit_after - select type(system) + select type(nbody_system) class is (symba_nbody_system) select type(param) - class is (symba_parameters) - associate(pl => self, plplenc_list => system%plplenc_list, plplcollision_list => system%plplcollision_list) - call pl%vb2vh(system%cb) - call pl%xh2xb(system%cb) - call plplenc_list%write(pl, pl, param) + class is (swiftest_parameters) + associate(pl => self, plpl_encounter => nbody_system%plpl_encounter, plpl_collision => nbody_system%plpl_collision) + call pl%vb2vh(nbody_system%cb) + call pl%rh2rb(nbody_system%cb) + !call plpl_encounter%write(pl, pl, param) TODO: write the encounter list writer for NetCDF - call symba_discard_nonplpl(self, system, param) + call symba_discard_nonplpl(self, nbody_system, param) if (.not.any(pl%ldiscard(:))) return if (param%lenergy) then - call system%get_energy_and_momentum(param) - Eorbit_before = system%te + call nbody_system%get_energy_and_momentum(param) + Eorbit_before = nbody_system%te end if - call symba_discard_nonplpl_conservation(self, system, param) + call symba_discard_nonplpl_conservation(self, nbody_system, param) ! Save the add/discard information to file - call system%write_discard(param) + call nbody_system%write_discard(param) - call pl%rearray(system, param) + call pl%rearray(nbody_system, param) if (param%lenergy) then - call system%get_energy_and_momentum(param) - Eorbit_after = system%te - system%Ecollisions = system%Ecollisions + (Eorbit_after - Eorbit_before) + call nbody_system%get_energy_and_momentum(param) + Eorbit_after = nbody_system%te + nbody_system%Ecollisions = nbody_system%Ecollisions + (Eorbit_after - Eorbit_before) end if end associate diff --git a/src/symba/symba_drift.f90 b/src/symba/symba_drift.f90 index 767ea8b01..e6cc0e761 100644 --- a/src/symba/symba_drift.f90 +++ b/src/symba/symba_drift.f90 @@ -7,27 +7,27 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. - submodule (symba_classes) s_symba_drift + submodule (symba) s_symba_drift use swiftest contains - module subroutine symba_drift_pl(self, system, param, dt) + module subroutine symba_drift_pl(self, nbody_system, param, dt) !! author: David A. Minton !! !! Wrapper function used to call the body drift routine from a symba_pl structure implicit none ! Arguments class(symba_pl), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + 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 if (self%nbody == 0) return associate(pl => self, npl => self%nbody) - select type(system) + select type(nbody_system) class is (symba_nbody_system) - pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == system%irec - call helio_drift_body(pl, system, param, dt) + pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == nbody_system%irec + call helio_drift_body(pl, nbody_system, param, dt) pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE end select end associate @@ -36,23 +36,23 @@ module subroutine symba_drift_pl(self, system, param, dt) end subroutine symba_drift_pl - module subroutine symba_drift_tp(self, system, param, dt) + module subroutine symba_drift_tp(self, nbody_system, param, dt) !! author: David A. Minton !! !! Wrapper function used to call the body drift routine from a symba_pl structure implicit none ! Arguments class(symba_tp), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + 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 if (self%nbody == 0) return associate (tp => self, ntp => self%nbody) - select type(system) + select type(nbody_system) class is (symba_nbody_system) - tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == system%irec - call helio_drift_body(tp, system, param, dt) + tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == nbody_system%irec + call helio_drift_body(tp, nbody_system, param, dt) tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE end select end associate diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index 035d7fd3c..c454fffb0 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -7,11 +7,11 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (symba_classes) s_symba_encounter_check +submodule (symba) s_symba_encounter_check use swiftest contains - module function symba_encounter_check_pl(self, param, system, dt, irec) result(lany_encounter) + module function symba_encounter_check_pl(self, param, nbody_system, dt, irec) result(lany_encounter) !! author: David A. Minton !! !! Check for an encounter between massive bodies. @@ -20,7 +20,7 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l ! Arguments class(symba_pl), intent(inout) :: self !! SyMBA test particle object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level ! Result @@ -34,7 +34,7 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l lany_encounter = .false. if (self%nbody == 0) return - associate(pl => self, plplenc_list => system%plplenc_list) + associate(pl => self, plpl_encounter => nbody_system%plpl_encounter, cb => nbody_system%cb) npl = pl%nbody nplm = pl%nplm @@ -43,28 +43,33 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l call pl%set_renc(irec) if (nplt == 0) then - call encounter_check_all_plpl(param, npl, pl%xh, pl%vh, pl%renc, dt, nenc, index1, index2, lvdotr) + call encounter_check_all_plpl(param, npl, pl%rh, pl%vb, pl%renc, dt, nenc, index1, index2, lvdotr) else - call encounter_check_all_plplm(param, nplm, nplt, pl%xh(:,1:nplm), pl%vh(:,1:nplm), pl%xh(:,nplm+1:npl), & - pl%vh(:,nplm+1:npl), pl%renc(1:nplm), pl%renc(nplm+1:npl), dt, nenc, index1, index2, lvdotr) + call encounter_check_all_plplm(param, nplm, nplt, pl%rh(:,1:nplm), pl%vb(:,1:nplm), pl%rh(:,nplm+1:npl), & + pl%vb(:,nplm+1:npl), pl%renc(1:nplm), pl%renc(nplm+1:npl), dt, nenc, index1, index2, lvdotr) end if lany_encounter = nenc > 0_I8B if (lany_encounter) then - call plplenc_list%resize(nenc) - call move_alloc(lvdotr, plplenc_list%lvdotr) - call move_alloc(index1, plplenc_list%index1) - call move_alloc(index2, plplenc_list%index2) + call plpl_encounter%resize(nenc) + call move_alloc(lvdotr, plpl_encounter%lvdotr) + call move_alloc(index1, plpl_encounter%index1) + call move_alloc(index2, plpl_encounter%index2) end if - if (lany_encounter) then + if (lany_encounter) then do k = 1_I8B, nenc - i = plplenc_list%index1(k) - j = plplenc_list%index2(k) - plplenc_list%id1(k) = pl%id(i) - plplenc_list%id2(k) = pl%id(j) - plplenc_list%status(k) = ACTIVE - plplenc_list%level(k) = irec + plpl_encounter%t = nbody_system%t + i = plpl_encounter%index1(k) + j = plpl_encounter%index2(k) + plpl_encounter%id1(k) = pl%id(i) + plpl_encounter%id2(k) = pl%id(j) + plpl_encounter%status(k) = ACTIVE + plpl_encounter%level(k) = irec + plpl_encounter%r1(:,k) = pl%rh(:,i) + plpl_encounter%r2(:,k) = pl%rh(:,j) + plpl_encounter%v1(:,k) = pl%vb(:,i) - cb%vb(:) + plpl_encounter%v2(:,k) = pl%vb(:,j) - cb%vb(:) pl%lencounter(i) = .true. pl%lencounter(j) = .true. pl%levelg(i) = irec @@ -82,113 +87,146 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l end function symba_encounter_check_pl - module function symba_encounter_check(self, param, system, dt, irec) result(lany_encounter) - !! author: David A. Minton - !! - !! Check for an encounter between test particles and massive bodies in the pltpenc list. - !! Note: This method works for the polymorphic symba_pltpenc and symba_plplenc types. - !! - !! Adapted from portions of David E. Kaufmann's Swifter routine: symba_step_recur.f90 + module function symba_encounter_check_list_plpl(self, param, nbody_system, dt, irec) result(lany_encounter) implicit none - ! Arguments - class(symba_encounter), intent(inout) :: self !! SyMBA pl-pl encounter list object + class(symba_list_plpl), intent(inout) :: self !! SyMBA pl-pl encounter list object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level logical :: lany_encounter !! Returns true if there is at least one close encounter ! Internals integer(I4B) :: i, j, k, lidx, nenc_enc real(DP), dimension(NDIM) :: xr, vr - logical :: isplpl real(DP) :: rlim2, rji2, rcrit12 logical, dimension(:), allocatable :: lencmask, lencounter - integer(I4B), dimension(:), allocatable :: encidx + integer(I4B), dimension(:), allocatable :: eidx lany_encounter = .false. if (self%nenc == 0) return - select type(self) - class is (symba_plplenc) - isplpl = .true. - class is (symba_pltpenc) - isplpl = .false. + select type(pl => nbody_system%pl) + class is (symba_pl) + allocate(lencmask(self%nenc)) + lencmask(:) = (self%status(1:self%nenc) == ACTIVE) .and. (self%level(1:self%nenc) == irec - 1) + nenc_enc = count(lencmask(:)) + if (nenc_enc == 0) return + + call pl%set_renc(irec) + + allocate(eidx(nenc_enc)) + allocate(lencounter(nenc_enc)) + eidx(:) = pack([(k, k = 1, self%nenc)], lencmask(:)) + lencounter(:) = .false. + + do concurrent(lidx = 1:nenc_enc) + k = eidx(lidx) + i = self%index1(k) + j = self%index2(k) + xr(:) = pl%rh(:,j) - pl%rh(:,i) + vr(:) = pl%vb(:,j) - pl%vb(:,i) + rcrit12 = pl%renc(i) + pl%renc(j) + call encounter_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), rcrit12, dt, lencounter(lidx), self%lvdotr(k)) + if (lencounter(lidx)) then + rlim2 = (pl%radius(i) + pl%radius(j))**2 + rji2 = dot_product(xr(:), xr(:))! Check to see if these are physically overlapping bodies first, which we should ignore + lencounter(lidx) = rji2 > rlim2 + end if + end do + + lany_encounter = any(lencounter(:)) + if (lany_encounter) then + nenc_enc = count(lencounter(:)) + eidx(1:nenc_enc) = pack(eidx(:), lencounter(:)) + do lidx = 1, nenc_enc + k = eidx(lidx) + i = self%index1(k) + j = self%index2(k) + pl%levelg(i) = irec + pl%levelm(i) = MAX(irec, pl%levelm(i)) + pl%levelg(j) = irec + pl%levelm(j) = MAX(irec, pl%levelm(j)) + self%level(k) = irec + end do + end if end select - select type(pl => system%pl) + return + end function symba_encounter_check_list_plpl + + + module function symba_encounter_check_list_pltp(self, param, nbody_system, dt, irec) result(lany_encounter) + implicit none + class(symba_list_pltp), intent(inout) :: self !! SyMBA pl-tp encounter list object + class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + logical :: lany_encounter !! Returns true if there is at least one close encounter + ! Internals + integer(I4B) :: i, j, k, lidx, nenc_enc + real(DP), dimension(NDIM) :: xr, vr + real(DP) :: rlim2, rji2 + logical, dimension(:), allocatable :: lencmask, lencounter + integer(I4B), dimension(:), allocatable :: eidx + + lany_encounter = .false. + if (self%nenc == 0) return + + select type(pl => nbody_system%pl) class is (symba_pl) - select type(tp => system%tp) - class is (symba_tp) - allocate(lencmask(self%nenc)) - lencmask(:) = (self%status(1:self%nenc) == ACTIVE) .and. (self%level(1:self%nenc) == irec - 1) - nenc_enc = count(lencmask(:)) - if (nenc_enc == 0) return - - call pl%set_renc(irec) - - allocate(encidx(nenc_enc)) - allocate(lencounter(nenc_enc)) - encidx(:) = pack([(k, k = 1, self%nenc)], lencmask(:)) - lencounter(:) = .false. - if (isplpl) then - do concurrent(lidx = 1:nenc_enc) - k = encidx(lidx) - i = self%index1(k) - j = self%index2(k) - xr(:) = pl%xh(:,j) - pl%xh(:,i) - vr(:) = pl%vh(:,j) - pl%vh(:,i) - rcrit12 = pl%renc(i) + pl%renc(j) - call encounter_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), rcrit12, dt, lencounter(lidx), self%lvdotr(k)) - if (lencounter(lidx)) then - rlim2 = (pl%radius(i) + pl%radius(j))**2 - rji2 = dot_product(xr(:), xr(:))! Check to see if these are physically overlapping bodies first, which we should ignore - lencounter(lidx) = rji2 > rlim2 - end if - end do - else - do concurrent(lidx = 1:nenc_enc) - k = encidx(lidx) - i = self%index1(k) - j = self%index2(k) - xr(:) = tp%xh(:,j) - pl%xh(:,i) - vr(:) = tp%vh(:,j) - pl%vh(:,i) - call encounter_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), pl%renc(i), dt, & - lencounter(lidx), self%lvdotr(k)) - if (lencounter(lidx)) then - rlim2 = (pl%radius(i))**2 - rji2 = dot_product(xr(:), xr(:))! Check to see if these are physically overlapping bodies first, which we should ignore - lencounter(lidx) = rji2 > rlim2 - end if - end do + select type(tp => nbody_system%tp) + class is (symba_tp) + allocate(lencmask(self%nenc)) + lencmask(:) = (self%status(1:self%nenc) == ACTIVE) .and. (self%level(1:self%nenc) == irec - 1) + nenc_enc = count(lencmask(:)) + if (nenc_enc == 0) return + + call pl%set_renc(irec) + + allocate(eidx(nenc_enc)) + allocate(lencounter(nenc_enc)) + eidx(:) = pack([(k, k = 1, self%nenc)], lencmask(:)) + lencounter(:) = .false. + + do concurrent(lidx = 1:nenc_enc) + k = eidx(lidx) + i = self%index1(k) + j = self%index2(k) + xr(:) = tp%rh(:,j) - pl%rh(:,i) + vr(:) = tp%vb(:,j) - pl%vb(:,i) + call encounter_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), pl%renc(i), dt, & + lencounter(lidx), self%lvdotr(k)) + if (lencounter(lidx)) then + rlim2 = (pl%radius(i))**2 + rji2 = dot_product(xr(:), xr(:))! Check to see if these are physically overlapping bodies first, which we should ignore + lencounter(lidx) = rji2 > rlim2 end if - lany_encounter = any(lencounter(:)) - if (lany_encounter) then - nenc_enc = count(lencounter(:)) - encidx(1:nenc_enc) = pack(encidx(:), lencounter(:)) - do lidx = 1, nenc_enc - k = encidx(lidx) - i = self%index1(k) - j = self%index2(k) - pl%levelg(i) = irec - pl%levelm(i) = MAX(irec, pl%levelm(i)) - if (isplpl) then - pl%levelg(j) = irec - pl%levelm(j) = MAX(irec, pl%levelm(j)) - else - tp%levelg(j) = irec - tp%levelm(j) = MAX(irec, tp%levelm(j)) - end if - self%level(k) = irec - end do - end if - end select + end do + + lany_encounter = any(lencounter(:)) + if (lany_encounter) then + nenc_enc = count(lencounter(:)) + eidx(1:nenc_enc) = pack(eidx(:), lencounter(:)) + do lidx = 1, nenc_enc + k = eidx(lidx) + i = self%index1(k) + j = self%index2(k) + pl%levelg(i) = irec + pl%levelm(i) = MAX(irec, pl%levelm(i)) + tp%levelg(j) = irec + tp%levelm(j) = MAX(irec, tp%levelm(j)) + self%level(k) = irec + end do + end if + end select end select return - end function symba_encounter_check + end function symba_encounter_check_list_pltp - module function symba_encounter_check_tp(self, param, system, dt, irec) result(lany_encounter) + module function symba_encounter_check_tp(self, param, nbody_system, dt, irec) result(lany_encounter) !! author: David A. Minton !! !! Check for an encounter between test particles and massive bodies. @@ -197,7 +235,7 @@ module function symba_encounter_check_tp(self, param, system, dt, irec) result(l ! Arguments class(symba_tp), intent(inout) :: self !! SyMBA test particle object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level ! Result @@ -211,27 +249,27 @@ module function symba_encounter_check_tp(self, param, system, dt, irec) result(l lany_encounter = .false. if (self%nbody == 0) return - associate(tp => self, ntp => self%nbody, pl => system%pl, npl => system%pl%nbody) + associate(tp => self, ntp => self%nbody, pl => nbody_system%pl, npl => nbody_system%pl%nbody) call pl%set_renc(irec) - call encounter_check_all_pltp(param, npl, ntp, pl%xh, pl%vh, tp%xh, tp%vh, pl%renc, dt, nenc, index1, index2, lvdotr) + call encounter_check_all_pltp(param, npl, ntp, pl%rh, pl%vb, tp%rh, tp%vb, pl%renc, dt, nenc, index1, index2, lvdotr) lany_encounter = nenc > 0 if (lany_encounter) then - associate(pltpenc_list => system%pltpenc_list) - call pltpenc_list%resize(nenc) - pltpenc_list%status(1:nenc) = ACTIVE - pltpenc_list%level(1:nenc) = irec - call move_alloc(index1, pltpenc_list%index1) - call move_alloc(index2, pltpenc_list%index2) - call move_alloc(lvdotr, pltpenc_list%lvdotr) - pltpenc_list%id1(1:nenc) = pl%id(pltpenc_list%index1(1:nenc)) - pltpenc_list%id2(1:nenc) = tp%id(pltpenc_list%index2(1:nenc)) + associate(pltp_encounter => nbody_system%pltp_encounter) + call pltp_encounter%resize(nenc) + pltp_encounter%status(1:nenc) = ACTIVE + pltp_encounter%level(1:nenc) = irec + call move_alloc(index1, pltp_encounter%index1) + call move_alloc(index2, pltp_encounter%index2) + call move_alloc(lvdotr, pltp_encounter%lvdotr) + pltp_encounter%id1(1:nenc) = pl%id(pltp_encounter%index1(1:nenc)) + pltp_encounter%id2(1:nenc) = tp%id(pltp_encounter%index2(1:nenc)) select type(pl) class is (symba_pl) pl%lencounter(1:npl) = .false. do k = 1_I8B, nenc - plind = pltpenc_list%index1(k) - tpind = pltpenc_list%index2(k) + plind = pltp_encounter%index1(k) + tpind = pltp_encounter%index2(k) pl%lencounter(plind) = .true. pl%levelg(plind) = irec pl%levelm(plind) = irec diff --git a/src/symba/symba_gr.f90 b/src/symba/symba_gr.f90 index fea0f46d9..65a55c559 100644 --- a/src/symba/symba_gr.f90 +++ b/src/symba/symba_gr.f90 @@ -7,11 +7,11 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(symba_classes) s_symba_gr +submodule(symba) s_symba_gr use swiftest contains - pure module subroutine symba_gr_p4_pl(self, system, param, dt) + pure module subroutine symba_gr_p4_pl(self, nbody_system, param, dt) !! author: David A. Minton !! !! Position kick to massive bodies due to p**4 term in the post-Newtonian correction @@ -21,17 +21,17 @@ pure module subroutine symba_gr_p4_pl(self, system, param, dt) implicit none ! Arguments class(symba_pl), intent(inout) :: self !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + 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 !! Step size if (self%nbody == 0) return associate(pl => self, npl => self%nbody) - select type(system) + select type(nbody_system) class is (symba_nbody_system) - pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == system%irec - call helio_gr_p4_pl(pl, system, param, dt) + pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == nbody_system%irec + call helio_gr_p4_pl(pl, nbody_system, param, dt) pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE end select end associate @@ -40,7 +40,7 @@ pure module subroutine symba_gr_p4_pl(self, system, param, dt) end subroutine symba_gr_p4_pl - pure module subroutine symba_gr_p4_tp(self, system, param, dt) + pure module subroutine symba_gr_p4_tp(self, nbody_system, param, dt) !! author: David A. Minton !! !! Position kick to test particles due to p**4 term in the post-Newtonian correction @@ -50,17 +50,17 @@ pure module subroutine symba_gr_p4_tp(self, system, param, dt) implicit none ! Arguments class(symba_tp), intent(inout) :: self !! SyMBA test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + 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 !! Step size if (self%nbody == 0) return associate(tp => self, ntp => self%nbody) - select type(system) + select type(nbody_system) class is (symba_nbody_system) - tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == system%irec - call helio_gr_p4_tp(tp, system, param, dt) + tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == nbody_system%irec + call helio_gr_p4_tp(tp, nbody_system, param, dt) tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE end select end associate diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 7f2792309..e5fdbc25d 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -7,253 +7,10 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (symba_classes) s_symba_io +submodule (symba) s_symba_io use swiftest contains - module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, iomsg) - !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Read in parameters specific to the SyMBA integrator, then calls the base io_param_reader. - !! - !! Adapted from David E. Kaufmann's Swifter routine io_init_param.f90 - !! Adapted from Martin Duncan's Swift routine io_init_param.f - implicit none - ! Arguments - class(symba_parameters), intent(inout) :: self !! Collection of parameters - integer, 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, intent(in) :: v_list(:) !! The first element passes the integrator code to the reader - integer, intent(out) :: iostat !! IO status code - character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 - ! internals - integer(I4B) :: ilength, ifirst, ilast !! Variables used to parse input file - character(STRMAX) :: line !! Line of the input file - character (len=:), allocatable :: line_trim,param_name, param_value !! Strings used to parse the param file - integer(I4B) :: nseeds, nseeds_from_file, i - logical :: seed_set = .false. !! Is the random seed set in the input file? - character(len=*),parameter :: linefmt = '(A)' - - associate(param => self) - open(unit = unit, file = param%param_file_name, status = 'old', err = 667, iomsg = iomsg) - call random_seed(size = nseeds) - if (allocated(param%seed)) deallocate(param%seed) - allocate(param%seed(nseeds)) - do - read(unit = unit, fmt = linefmt, iostat = iostat, end = 1, err = 667, iomsg = iomsg) line - line_trim = trim(adjustl(line)) - ilength = len(line_trim) - if ((ilength /= 0)) then - ifirst = 1 - ! Read the pair of tokens. The first one is the parameter name, the second is the value. - param_name = io_get_token(line_trim, ifirst, ilast, iostat) - if (param_name == '') cycle ! No parameter name (usually because this line is commented out) - call io_toupper(param_name) - ifirst = ilast + 1 - param_value = io_get_token(line_trim, ifirst, ilast, iostat) - select case (param_name) - case ("OUT_STAT") ! We need to duplicate this from the standard io_param_reader in order to make sure that the restart flag gets set properly in SyMBA - call io_toupper(param_value) - param%out_stat = param_value - case ("FRAGMENTATION") - call io_toupper(param_value) - if (param_value == "YES" .or. param_value == "T") self%lfragmentation = .true. - case ("GMTINY") - read(param_value, *) param%GMTINY - case ("MIN_GMFRAG") - read(param_value, *) param%min_GMfrag - case("SEED") - read(param_value, *) nseeds_from_file - ! Because the number of seeds can vary between compilers/systems, we need to make sure we can handle cases in which the input file has a different - ! number of seeds than the current system. If the number of seeds in the file is smaller than required, we will use them as a source to fill in the missing elements. - ! If the number of seeds in the file is larger than required, we will truncate the seed array. - if (nseeds_from_file > nseeds) then - nseeds = nseeds_from_file - deallocate(param%seed) - allocate(param%seed(nseeds)) - do i = 1, nseeds - ifirst = ilast + 2 - param_value = io_get_token(line, ifirst, ilast, iostat) - read(param_value, *) param%seed(i) - end do - else ! Seed array in file is too small - do i = 1, nseeds_from_file - ifirst = ilast + 2 - param_value = io_get_token(line, ifirst, ilast, iostat) - read(param_value, *) param%seed(i) - end do - param%seed(nseeds_from_file+1:nseeds) = [(param%seed(1) - param%seed(nseeds_from_file) + i, & - i=nseeds_from_file+1, nseeds)] - end if - seed_set = .true. - end select - end if - end do - 1 continue - close(unit) - - param%lrestart = (param%out_stat == "APPEND") - - if (self%GMTINY < 0.0_DP) then - write(iomsg,*) "GMTINY invalid or not set: ", self%GMTINY - iostat = -1 - return - end if - - if (param%lfragmentation) then - if (seed_set) then - call random_seed(put = param%seed) - else - call random_seed(get = param%seed) - end if - if (param%min_GMfrag < 0.0_DP) param%min_GMfrag = param%GMTINY - end if - - ! All reporting of collision information in SyMBA (including mergers) is now recorded in the Fraggle logfile - call io_log_start(param, FRAGGLE_LOG_OUT, "Fraggle logfile") - - ! Call the base method (which also prints the contents to screen) - call io_param_reader(param, unit, iotype, v_list, iostat, iomsg) - end associate - - iostat = 0 - - return - 667 continue - write(*,*) "Error reading SyMBA parameters in param file: ", trim(adjustl(iomsg)) - end subroutine symba_io_param_reader - - - module subroutine symba_io_param_writer(self, unit, iotype, v_list, iostat, iomsg) - !! author: David A. Minton - !! - !! Dump integration parameters specific to SyMBA to file and then call the base io_param_writer method. - !! - !! Adapted from David E. Kaufmann's Swifter routine io_dump_param.f90 - !! Adapted from Martin Duncan's Swift routine io_dump_param.f - implicit none - ! Arguments - class(symba_parameters),intent(in) :: self !! Collection of SyMBA parameters - integer, 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, intent(in) :: v_list(:) !! Not used in this procedure - integer, intent(out) :: iostat !! IO status code - character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 - ! Internals - integer(I4B) :: nseeds - - associate(param => self) - call io_param_writer(param, unit, iotype, v_list, iostat, iomsg) - - ! Special handling is required for writing the random number seed array as its size is not known until runtime - ! For the "SEED" parameter line, the first value will be the size of the seed array and the rest will be the seed array elements - call io_param_writer_one("GMTINY",param%GMTINY, unit) - call io_param_writer_one("MIN_GMFRAG",param%min_GMfrag, unit) - call io_param_writer_one("FRAGMENTATION",param%lfragmentation, unit) - if (param%lfragmentation) then - nseeds = size(param%seed) - call io_param_writer_one("SEED", [nseeds, param%seed(:)], unit) - end if - - iostat = 0 - end associate - - return - 667 continue - write(*,*) "Error writing parameter file for SyMBA: " // trim(adjustl(iomsg)) - end subroutine symba_io_param_writer - - - module subroutine symba_io_write_discard(self, param) - !! author: David A. Minton - !! - !! Write the metadata of the discarded body to the output file - implicit none - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: iadd, isub, j, nsub, nadd - logical, save :: lfirst = .true. - character(*), parameter :: HDRFMT = '(E23.16, 1X, I8, 1X, L1)' - character(*), parameter :: NAMEFMT = '(A, 2(1X, I8))' - character(*), parameter :: VECFMT = '(3(E23.16, 1X))' - character(*), parameter :: NPLFMT = '(I8)' - character(*), parameter :: PLNAMEFMT = '(I8, 2(1X, E23.16))' - character(STRMAX) :: errmsg, out_stat - - associate(pl => self%pl, npl => self%pl%nbody, pl_adds => self%pl_adds) - - if (self%tp_discards%nbody > 0) call io_write_discard(self, param) - select type(pl_discards => self%pl_discards) - class is (symba_merger) - if (pl_discards%nbody == 0) return - - ! Record the discarded body metadata information to file - if ((param%out_type == NETCDF_FLOAT_TYPE) .or. (param%out_type == NETCDF_DOUBLE_TYPE)) then - call pl_discards%write_particle_info(param%nciu, param) - end if - - if (param%discard_out == "") return - if (lfirst) then - out_stat = param%out_stat - else - out_stat = 'APPEND' - end if - select case(out_stat) - case('APPEND') - open(unit=LUN, file=param%discard_out, status='OLD', position='APPEND', form='FORMATTED', err=667, iomsg=errmsg) - case('NEW', 'REPLACE', 'UNKNOWN') - open(unit=LUN, file=param%discard_out, status=param%out_stat, form='FORMATTED', err=667, iomsg=errmsg) - case default - write(*,*) 'Invalid status code for OUT_STAT: ',trim(adjustl(param%out_stat)) - call util_exit(FAILURE) - end select - lfirst = .false. - if (param%lgr) then - call pl_discards%pv2v(param) - call pl_adds%pv2v(param) - end if - - write(LUN, HDRFMT, err=667, iomsg=errmsg) param%t, pl_discards%nbody, param%lbig_discard - iadd = 1 - isub = 1 - do while (iadd <= pl_adds%nbody) - nadd = pl_adds%ncomp(iadd) - nsub = pl_discards%ncomp(isub) - do j = 1, nadd - if (iadd <= pl_adds%nbody) then - write(LUN, NAMEFMT, err=667, iomsg=errmsg) ADD, pl_adds%id(iadd), pl_adds%status(iadd) - write(LUN, VECFMT, err=667, iomsg=errmsg) pl_adds%xh(1, iadd), pl_adds%xh(2, iadd), pl_adds%xh(3, iadd) - write(LUN, VECFMT, err=667, iomsg=errmsg) pl_adds%vh(1, iadd), pl_adds%vh(2, iadd), pl_adds%vh(3, iadd) - else - exit - end if - iadd = iadd + 1 - end do - do j = 1, nsub - if (isub <= pl_discards%nbody) then - write(LUN,NAMEFMT,err=667,iomsg=errmsg) SUB, pl_discards%id(isub), pl_discards%status(isub) - write(LUN,VECFMT,err=667,iomsg=errmsg) pl_discards%xh(1,isub), pl_discards%xh(2,isub), pl_discards%xh(3,isub) - write(LUN,VECFMT,err=667,iomsg=errmsg) pl_discards%vh(1,isub), pl_discards%vh(2,isub), pl_discards%vh(3,isub) - else - exit - end if - isub = isub + 1 - end do - end do - - close(LUN) - end select - end associate - - return - - 667 continue - write(*,*) "Error writing discard file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine symba_io_write_discard end submodule s_symba_io diff --git a/src/symba/symba_kick.f90 b/src/symba/symba_kick.f90 index 476fd1697..5ab8480d1 100644 --- a/src/symba/symba_kick.f90 +++ b/src/symba/symba_kick.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(symba_classes) s_symba_kick +submodule(symba) s_symba_kick use swiftest contains @@ -23,39 +23,39 @@ module subroutine symba_kick_getacch_int_pl(self, param) class(symba_pl), intent(inout) :: self !! SyMBA massive body object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameter ! Internals - type(interaction_timer), save :: itimer - logical, save :: lfirst = .true. - - if (param%ladaptive_interactions) then - if (self%nplplm > 0) then - if (lfirst) then - write(itimer%loopname, *) "symba_kick_getacch_int_pl" - write(itimer%looptype, *) "INTERACTION" - call itimer%time_this_loop(param, self%nplplm, self) - lfirst = .false. - else - if (itimer%check(param, self%nplplm)) call itimer%time_this_loop(param, self%nplplm, self) - end if - else - param%lflatten_interactions = .false. - end if - end if + ! type(interaction_timer), save :: itimer + ! logical, save :: lfirst = .true. + + ! if (param%ladaptive_interactions) then + ! if (self%nplplm > 0) then + ! if (lfirst) then + ! write(itimer%loopname, *) "symba_kick_getacch_int_pl" + ! write(itimer%looptype, *) "INTERACTION" + ! call itimer%time_this_loop(param, self%nplplm, self) + ! lfirst = .false. + ! else + ! if (itimer%netcdf_io_check(param, self%nplplm)) call itimer%time_this_loop(param, self%nplplm, self) + ! end if + ! else + ! param%lflatten_interactions = .false. + ! end if + ! end if - if (param%lflatten_interactions) then - call kick_getacch_int_all_flat_pl(self%nbody, self%nplplm, self%k_plpl, self%xh, self%Gmass, self%radius, self%ah) - else - call kick_getacch_int_all_triangular_pl(self%nbody, self%nplm, self%xh, self%Gmass, self%radius, self%ah) - end if + ! if (param%lflatten_interactions) then + ! call swiftest_kick_getacch_int_all_flat_pl(self%nbody, self%nplplm, self%k_plpl, self%rh, self%Gmass, self%radius, self%ah) + ! else + call swiftest_kick_getacch_int_all_triangular_pl(self%nbody, self%nplm, self%rh, self%Gmass, self%radius, self%ah) + ! end if - if (param%ladaptive_interactions .and. self%nplplm > 0) then - if (itimer%is_on) call itimer%adapt(param, self%nplplm, self) - end if + ! if (param%ladaptive_interactions .and. self%nplplm > 0) then + ! if (itimer%is_on) call itimer%adapt(param, self%nplplm, self) + ! end if return end subroutine symba_kick_getacch_int_pl - module subroutine symba_kick_getacch_pl(self, system, param, t, lbeg) + module subroutine symba_kick_getacch_pl(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Compute heliocentric accelerations of massive bodies @@ -65,7 +65,7 @@ module subroutine symba_kick_getacch_pl(self, system, param, t, lbeg) implicit none ! Arguments class(symba_pl), intent(inout) :: self !! SyMBA massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system 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 !! Current simulation time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step @@ -75,19 +75,19 @@ module subroutine symba_kick_getacch_pl(self, system, param, t, lbeg) integer(I4B), dimension(:,:), allocatable :: k_plpl_enc if (self%nbody == 0) return - select type(system) + select type(nbody_system) class is (symba_nbody_system) - associate(pl => self, npl => self%nbody, nplm => self%nplm, plplenc_list => system%plplenc_list, radius => self%radius) + associate(pl => self, npl => self%nbody, nplm => self%nplm, plpl_encounter => nbody_system%plpl_encounter, radius => self%radius) ! Apply kicks to all bodies (including those in the encounter list) - call helio_kick_getacch_pl(pl, system, param, t, lbeg) - if (plplenc_list%nenc > 0) then + call helio_kick_getacch_pl(pl, nbody_system, param, t, lbeg) + if (plpl_encounter%nenc > 0) then ! Remove kicks from bodies involved currently in the encounter list, as these are dealt with separately. ah_enc(:,:) = 0.0_DP - nplplenc = int(plplenc_list%nenc, kind=I8B) + nplplenc = int(plpl_encounter%nenc, kind=I8B) allocate(k_plpl_enc(2,nplplenc)) - k_plpl_enc(1,1:nplplenc) = plplenc_list%index1(1:nplplenc) - k_plpl_enc(2,1:nplplenc) = plplenc_list%index2(1:nplplenc) - call kick_getacch_int_all_flat_pl(npl, nplplenc, k_plpl_enc, pl%xh, pl%Gmass, pl%radius, ah_enc) + k_plpl_enc(1,1:nplplenc) = plpl_encounter%index1(1:nplplenc) + k_plpl_enc(2,1:nplplenc) = plpl_encounter%index2(1:nplplenc) + call swiftest_kick_getacch_int_all_flat_pl(npl, nplplenc, k_plpl_enc, pl%rh, pl%Gmass, pl%radius, ah_enc) pl%ah(:,1:npl) = pl%ah(:,1:npl) - ah_enc(:,1:npl) end if @@ -98,7 +98,7 @@ module subroutine symba_kick_getacch_pl(self, system, param, t, lbeg) end subroutine symba_kick_getacch_pl - module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) + module subroutine symba_kick_getacch_tp(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Compute heliocentric accelerations of test particles @@ -108,7 +108,7 @@ module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) implicit none ! Arguments class(symba_tp), intent(inout) :: self !! SyMBA test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system 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 !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step @@ -118,20 +118,20 @@ module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) real(DP), dimension(NDIM) :: dx if (self%nbody == 0) return - select type(system) + select type(nbody_system) class is (symba_nbody_system) - associate(tp => self, cb => system%cb, pl => system%pl, & - pltpenc_list => system%pltpenc_list, npltpenc => system%pltpenc_list%nenc) - call helio_kick_getacch_tp(tp, system, param, t, lbeg) + associate(tp => self, cb => nbody_system%cb, pl => nbody_system%pl, & + pltp_encounter => nbody_system%pltp_encounter, npltpenc => nbody_system%pltp_encounter%nenc) + call helio_kick_getacch_tp(tp, nbody_system, param, t, lbeg) ! Remove accelerations from encountering pairs do k = 1, npltpenc - i = pltpenc_list%index1(k) - j = pltpenc_list%index2(k) + i = pltp_encounter%index1(k) + j = pltp_encounter%index2(k) if (tp%lmask(j)) then if (lbeg) then - dx(:) = tp%xh(:,j) - pl%xbeg(:,i) + dx(:) = tp%rh(:,j) - pl%rbeg(:,i) else - dx(:) = tp%xh(:,j) - pl%xend(:,i) + dx(:) = tp%rh(:,j) - pl%rend(:,i) end if rjj = dot_product(dx(:), dx(:)) fac = pl%Gmass(i) / (rjj * sqrt(rjj)) @@ -144,18 +144,17 @@ module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) end subroutine symba_kick_getacch_tp - module subroutine symba_kick_encounter(self, system, dt, irec, sgn) + module subroutine symba_kick_list_plpl(self, nbody_system, dt, irec, sgn) !! author: David A. Minton !! - !! Kick barycentric velocities of massive bodies and ACTIVE test particles within SyMBA recursion. - !! Note: This method works for the polymorphic symba_pltpenc and symba_plplenc types + !! Kick barycentric velocities of massive bodies within SyMBA recursion. !! !! Adapted from David E. Kaufmann's Swifter routine: symba_kick.f90 !! Adapted from Hal Levison's Swift routine symba5_kick.f implicit none ! Arguments - class(symba_encounter), intent(in) :: self !! SyMBA pl-tp encounter list object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_list_plpl), intent(in) :: self !! SyMBA pl-tp encounter list object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level integer(I4B), intent(in) :: sgn !! sign to be applied to acceleration @@ -164,130 +163,195 @@ module subroutine symba_kick_encounter(self, system, dt, irec, sgn) integer(I8B) :: k real(DP) :: r, rr, ri, ris, rim1, r2, ir3, fac, faci, facj real(DP), dimension(NDIM) :: dx - logical :: isplpl logical, dimension(:), allocatable :: lgoodlevel integer(I4B), dimension(:), allocatable :: good_idx if (self%nenc == 0) return - select type(self) - class is (symba_plplenc) - isplpl = .true. - class is (symba_pltpenc) - isplpl = .false. - end select - select type(pl => system%pl) + select type(pl => nbody_system%pl) class is (symba_pl) - select type(tp => system%tp) - class is (symba_tp) - associate(npl => pl%nbody, ntp => tp%nbody, nenc => self%nenc) - if (npl == 0) return - pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE - if (.not. isplpl) then - if (ntp == 0) return - tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE - end if - allocate(lgoodlevel(nenc)) + associate(npl => pl%nbody, nenc => self%nenc) + if (npl == 0) return + pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE + allocate(lgoodlevel(nenc)) - irm1 = irec - 1 + irm1 = irec - 1 - if (sgn < 0) then - irecl = irec - 1 - else - irecl = irec - end if + if (sgn < 0) then + irecl = irec - 1 + else + irecl = irec + end if + + do k = 1, nenc + i = self%index1(k) + j = self%index2(k) + lgoodlevel(k) = (pl%levelg(i) >= irm1) .and. (pl%levelg(j) >= irm1) + lgoodlevel(k) = (self%status(k) == ACTIVE) .and. lgoodlevel(k) + end do + ngood = count(lgoodlevel(:)) + if (ngood > 0_I8B) then + allocate(good_idx(ngood)) + good_idx(:) = pack([(i, i = 1, nenc)], lgoodlevel(:)) + + do concurrent (k = 1:ngood) + i = self%index1(good_idx(k)) + j = self%index2(good_idx(k)) + pl%ah(:,i) = 0.0_DP + pl%ah(:,j) = 0.0_DP + end do - do k = 1, nenc - i = self%index1(k) - j = self%index2(k) - if (isplpl) then - lgoodlevel(k) = (pl%levelg(i) >= irm1) .and. (pl%levelg(j) >= irm1) + do k = 1, ngood + i = self%index1(good_idx(k)) + j = self%index2(good_idx(k)) + ri = ((pl%rhill(i) + pl%rhill(j))**2) * (RHSCALE**2) * (RSHELL**(2*irecl)) + rim1 = ri * (RSHELL**2) + dx(:) = pl%rh(:,j) - pl%rh(:,i) + + r2 = dot_product(dx(:), dx(:)) + if (r2 < rim1) then + fac = 0.0_DP + lgoodlevel(good_idx(k)) = .false. + cycle + end if + if (r2 < ri) then + ris = sqrt(ri) + r = sqrt(r2) + rr = (ris - r) / (ris * (1.0_DP - RSHELL)) + fac = (r2**(-1.5_DP)) * (1.0_DP - 3 * (rr**2) + 2 * (rr**3)) else - lgoodlevel(k) = (pl%levelg(i) >= irm1) .and. (tp%levelg(j) >= irm1) + ir3 = 1.0_DP / (r2 * sqrt(r2)) + fac = ir3 end if - lgoodlevel(k) = (self%status(k) == ACTIVE) .and. lgoodlevel(k) + faci = fac * pl%Gmass(i) + facj = fac * pl%Gmass(j) + pl%ah(:, i) = pl%ah(:, i) + facj * dx(:) + pl%ah(:, j) = pl%ah(:, j) - faci * dx(:) end do ngood = count(lgoodlevel(:)) - if (ngood > 0_I8B) then - allocate(good_idx(ngood)) - good_idx(:) = pack([(i, i = 1, nenc)], lgoodlevel(:)) - - if (isplpl) then - do concurrent (k = 1:ngood) - i = self%index1(good_idx(k)) - j = self%index2(good_idx(k)) - pl%ah(:,i) = 0.0_DP - pl%ah(:,j) = 0.0_DP - end do - else - do concurrent (k = 1_I8B:ngood) - j = self%index2(good_idx(k)) - tp%ah(:,j) = 0.0_DP - end do - end if + if (ngood == 0_I8B) return + good_idx(1:ngood) = pack([(i, i = 1, nenc)], lgoodlevel(:)) + + do k = 1, ngood + i = self%index1(good_idx(k)) + j = self%index2(good_idx(k)) + pl%vb(:,i) = pl%vb(:,i) + sgn * dt * pl%ah(:,i) + pl%vb(:,j) = pl%vb(:,j) + sgn * dt * pl%ah(:,j) + pl%ah(:,i) = 0.0_DP + pl%ah(:,j) = 0.0_DP + end do - do k = 1, ngood - i = self%index1(good_idx(k)) - j = self%index2(good_idx(k)) - if (isplpl) then - ri = ((pl%rhill(i) + pl%rhill(j))**2) * (RHSCALE**2) * (RSHELL**(2*irecl)) - rim1 = ri * (RSHELL**2) - dx(:) = pl%xh(:,j) - pl%xh(:,i) - else - ri = ((pl%rhill(i))**2) * (RHSCALE**2) * (RSHELL**(2*irecl)) - rim1 = ri * (RSHELL**2) - dx(:) = tp%xh(:,j) - pl%xh(:,i) - end if - r2 = dot_product(dx(:), dx(:)) - if (r2 < rim1) then - fac = 0.0_DP - lgoodlevel(good_idx(k)) = .false. - cycle - end if - if (r2 < ri) then - ris = sqrt(ri) - r = sqrt(r2) - rr = (ris - r) / (ris * (1.0_DP - RSHELL)) - fac = (r2**(-1.5_DP)) * (1.0_DP - 3 * (rr**2) + 2 * (rr**3)) - else - ir3 = 1.0_DP / (r2 * sqrt(r2)) - fac = ir3 - end if - faci = fac * pl%Gmass(i) - if (isplpl) then - facj = fac * pl%Gmass(j) - pl%ah(:, i) = pl%ah(:, i) + facj * dx(:) - pl%ah(:, j) = pl%ah(:, j) - faci * dx(:) - else - tp%ah(:, j) = tp%ah(:, j) - faci * dx(:) - end if - end do - ngood = count(lgoodlevel(:)) - if (ngood == 0_I8B) return - good_idx(1:ngood) = pack([(i, i = 1, nenc)], lgoodlevel(:)) - - if (isplpl) then - do k = 1, ngood - i = self%index1(good_idx(k)) - j = self%index2(good_idx(k)) - pl%vb(:,i) = pl%vb(:,i) + sgn * dt * pl%ah(:,i) - pl%vb(:,j) = pl%vb(:,j) + sgn * dt * pl%ah(:,j) - pl%ah(:,i) = 0.0_DP - pl%ah(:,j) = 0.0_DP - end do + end if + end associate + end select + + return + end subroutine symba_kick_list_plpl + + + module subroutine symba_kick_list_pltp(self, nbody_system, dt, irec, sgn) + !! author: David A. Minton + !! + !! Kick barycentric velocities of ACTIVE test particles within SyMBA recursion. + !! + !! Adapted from David E. Kaufmann's Swifter routine: symba_kick.f90 + !! Adapted from Hal Levison's Swift routine symba5_kick.f + implicit none + ! Arguments + class(symba_list_pltp), intent(in) :: self !! SyMBA pl-tp encounter list object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + integer(I4B), intent(in) :: sgn !! sign to be applied to acceleration + ! Internals + integer(I4B) :: i, j, irm1, irecl, ngood + integer(I8B) :: k + real(DP) :: r, rr, ri, ris, rim1, r2, ir3, fac, faci + real(DP), dimension(NDIM) :: dx + logical, dimension(:), allocatable :: lgoodlevel + integer(I4B), dimension(:), allocatable :: good_idx + + if (self%nenc == 0) return + + select type(pl => nbody_system%pl) + class is (symba_pl) + select type(tp => nbody_system%tp) + class is (symba_tp) + associate(npl => pl%nbody, ntp => tp%nbody, nenc => self%nenc) + if ((npl == 0) .or. (ntp == 0)) return + pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE + tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE + allocate(lgoodlevel(nenc)) + + irm1 = irec - 1 + + if (sgn < 0) then + irecl = irec - 1 + else + irecl = irec + end if + + do k = 1, nenc + i = self%index1(k) + j = self%index2(k) + lgoodlevel(k) = (pl%levelg(i) >= irm1) .and. (tp%levelg(j) >= irm1) + lgoodlevel(k) = (self%status(k) == ACTIVE) .and. lgoodlevel(k) + end do + + ngood = count(lgoodlevel(:)) + + if (ngood > 0_I8B) then + allocate(good_idx(ngood)) + good_idx(:) = pack([(i, i = 1, nenc)], lgoodlevel(:)) + + + do concurrent (k = 1_I8B:ngood) + j = self%index2(good_idx(k)) + tp%ah(:,j) = 0.0_DP + end do + + do k = 1, ngood + i = self%index1(good_idx(k)) + j = self%index2(good_idx(k)) + + ri = ((pl%rhill(i))**2) * (RHSCALE**2) * (RSHELL**(2*irecl)) + rim1 = ri * (RSHELL**2) + dx(:) = tp%rh(:,j) - pl%rh(:,i) + r2 = dot_product(dx(:), dx(:)) + if (r2 < rim1) then + fac = 0.0_DP + lgoodlevel(good_idx(k)) = .false. + cycle + end if + if (r2 < ri) then + ris = sqrt(ri) + r = sqrt(r2) + rr = (ris - r) / (ris * (1.0_DP - RSHELL)) + fac = (r2**(-1.5_DP)) * (1.0_DP - 3 * (rr**2) + 2 * (rr**3)) else - do k = 1, ngood - j = self%index2(good_idx(k)) - tp%vb(:,j) = tp%vb(:,j) + sgn * dt * tp%ah(:,j) - tp%ah(:,j) = 0.0_DP - end do + ir3 = 1.0_DP / (r2 * sqrt(r2)) + fac = ir3 end if - end if - end associate - end select + faci = fac * pl%Gmass(i) + + tp%ah(:, j) = tp%ah(:, j) - faci * dx(:) + end do + ngood = count(lgoodlevel(:)) + if (ngood == 0_I8B) return + good_idx(1:ngood) = pack([(i, i = 1, nenc)], lgoodlevel(:)) + + do k = 1, ngood + j = self%index2(good_idx(k)) + tp%vb(:,j) = tp%vb(:,j) + sgn * dt * tp%ah(:,j) + tp%ah(:,j) = 0.0_DP + end do + end if + end associate + end select end select return - end subroutine symba_kick_encounter + end subroutine symba_kick_list_pltp + end submodule s_symba_kick \ No newline at end of file diff --git a/src/symba/symba_module.f90 b/src/symba/symba_module.f90 new file mode 100644 index 000000000..f120919fe --- /dev/null +++ b/src/symba/symba_module.f90 @@ -0,0 +1,486 @@ +!! 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. + +module symba + !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Definition of classes and methods specific to the SyMBA integrator + !! Adapted from David E. Kaufmann's Swifter routine: module_symba.f90 + use swiftest + use helio + implicit none + public + + integer(I4B), private, parameter :: NENMAX = 32767 + integer(I4B), private, parameter :: NTENC = 3 + real(DP), private, parameter :: RHSCALE = 6.5_DP + real(DP), private, parameter :: RSHELL = 0.48075_DP + + + !> SyMBA central body particle class + type, extends(helio_cb) :: symba_cb + end type symba_cb + + + !> SyMBA massive body class + type, extends(helio_pl) :: symba_pl + integer(I4B), dimension(:), allocatable :: levelg !! level at which this body should be moved + integer(I4B), dimension(:), allocatable :: levelm !! deepest encounter level achieved this time step + contains + procedure :: flatten => symba_util_flatten_eucl_plpl !! Sets up the (i, j) -> k indexing used for the single-loop blocking Euclidean distance matrix + procedure :: discard => symba_discard_pl !! Process massive body discards + procedure :: drift => symba_drift_pl !! Method for Danby drift in Democratic Heliocentric coordinates. Sets the mask to the current recursion level + procedure :: encounter_check => symba_encounter_check_pl !! Checks if massive bodies are going through close encounters with each other + procedure :: gr_pos_kick => symba_gr_p4_pl !! Position kick due to p**4 term in the post-Newtonian correction + procedure :: accel_int => symba_kick_getacch_int_pl !! Compute direct cross (third) term heliocentric accelerations of massive bodiess, with no mutual interactions between bodies below GMTINY + procedure :: accel => symba_kick_getacch_pl !! Compute heliocentric accelerations of massive bodies + procedure :: setup => symba_util_setup_pl !! Constructor method - Allocates space for the input number of bodies + procedure :: append => symba_util_append_pl !! Appends elements from one structure to another + procedure :: dealloc => symba_util_dealloc_pl !! Deallocates all allocatable arrays + procedure :: fill => symba_util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) + procedure :: resize => symba_util_resize_pl !! Checks the current size of a SyMBA massive body against the requested size and resizes it if it is too small. + procedure :: set_renc_I4B => symba_util_set_renc !! Sets the critical radius for encounter given an input recursion depth + procedure :: sort => symba_util_sort_pl !! Sorts body arrays by a sortable componen + procedure :: rearrange => symba_util_sort_rearrange_pl !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods + procedure :: spill => symba_util_spill_pl !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) + final :: symba_final_pl !! Finalizes the SyMBA massive body object - deallocates all allocatables + end type symba_pl + + + !> SyMBA test particle class + type, extends(helio_tp) :: symba_tp + integer(I4B), dimension(:), allocatable :: levelg !! level at which this particle should be moved + integer(I4B), dimension(:), allocatable :: levelm !! deepest encounter level achieved this time step + contains + procedure :: drift => symba_drift_tp !! Method for Danby drift in Democratic Heliocentric coordinates. Sets the mask to the current recursion level + procedure :: encounter_check => symba_encounter_check_tp !! Checks if any test particles are undergoing a close encounter with a massive body + procedure :: gr_pos_kick => symba_gr_p4_tp !! Position kick due to p**4 term in the post-Newtonian correction + procedure :: accel => symba_kick_getacch_tp !! Compute heliocentric accelerations of test particles + procedure :: setup => symba_util_setup_tp !! Constructor method - Allocates space for the input number of bodies + procedure :: append => symba_util_append_tp !! Appends elements from one structure to another + procedure :: dealloc => symba_util_dealloc_tp !! Deallocates all allocatable arrays + procedure :: fill => symba_util_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) + procedure :: resize => symba_util_resize_tp !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. + procedure :: sort => symba_util_sort_tp !! Sorts body arrays by a sortable componen + procedure :: rearrange => symba_util_sort_rearrange_tp !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods + procedure :: spill => symba_util_spill_tp !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) + final :: symba_final_tp !! Finalizes the SyMBA test particle object - deallocates all allocatables + end type symba_tp + + + !> SyMBA class for tracking close encounters in a step + type, extends(collision_list_plpl) :: symba_list_plpl + contains + procedure :: encounter_check => symba_encounter_check_list_plpl !! Checks if massive bodies are going through close encounters with each other + procedure :: kick => symba_kick_list_plpl !! Kick barycentric velocities of active massive bodies within SyMBA recursion + final :: symba_final_list_plpl !! Finalizes the SyMBA test particle object - deallocates all allocatables + end type symba_list_plpl + + + !> SyMBA class for tracking close encounters in a step + type, extends(collision_list_pltp) :: symba_list_pltp + contains + procedure :: encounter_check => symba_encounter_check_list_pltp !! Checks if massive bodies are going through close encounters with test particles + procedure :: kick => symba_kick_list_pltp !! Kick barycentric velocities of active test particles within SyMBA recursion + final :: symba_final_list_pltp !! Finalizes the SyMBA test particle object - deallocates all allocatables + end type symba_list_pltp + + + type, extends(helio_nbody_system) :: symba_nbody_system + integer(I4B) :: irec !! nbody_system recursion level + contains + procedure :: initialize => symba_util_setup_initialize_system !! Performs SyMBA-specific initilization steps + procedure :: step => symba_step_system !! Advance the SyMBA nbody system forward in time by one step + procedure :: interp => symba_step_interp_system !! Perform an interpolation step on the SymBA nbody system + procedure :: set_recur_levels => symba_step_set_recur_levels_system !! Sets recursion levels of bodies and encounter lists to the current nbody_system level + procedure :: recursive_step => symba_step_recur_system !! Step interacting planets and active test particles ahead in democratic heliocentric coordinates at the current recursion level, if applicable, and descend to the next deeper level if necessary + procedure :: reset => symba_step_reset_system !! Resets pl, tp,and encounter structures at the start of a new step + final :: symba_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables + end type symba_nbody_system + + interface + module subroutine symba_discard_pl(self, nbody_system, param) + implicit none + class(symba_pl), intent(inout) :: self !! SyMBA 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 symba_discard_pl + + module subroutine symba_drift_pl(self, nbody_system, param, dt) + implicit none + class(symba_pl), intent(inout) :: self !! Helio 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 + real(DP), intent(in) :: dt !! Stepsize + end subroutine symba_drift_pl + + module subroutine symba_drift_tp(self, nbody_system, param, dt) + implicit none + class(symba_tp), intent(inout) :: self !! Helio 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 + real(DP), intent(in) :: dt !! Stepsize + end subroutine symba_drift_tp + + module function symba_encounter_check_pl(self, param, nbody_system, dt, irec) result(lany_encounter) + implicit none + class(symba_pl), intent(inout) :: self !! SyMBA test particle object + class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + logical :: lany_encounter !! Returns true if there is at least one close encounter + end function symba_encounter_check_pl + + module function symba_encounter_check_list_plpl(self, param, nbody_system, dt, irec) result(lany_encounter) + implicit none + class(symba_list_plpl), intent(inout) :: self !! SyMBA pl-pl encounter list object + class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + logical :: lany_encounter !! Returns true if there is at least one close encounter + end function symba_encounter_check_list_plpl + + module function symba_encounter_check_list_pltp(self, param, nbody_system, dt, irec) result(lany_encounter) + implicit none + class(symba_list_pltp), intent(inout) :: self !! SyMBA pl-tp encounter list object + class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + logical :: lany_encounter !! Returns true if there is at least one close encounter + end function symba_encounter_check_list_pltp + + module function symba_encounter_check_tp(self, param, nbody_system, dt, irec) result(lany_encounter) + implicit none + class(symba_tp), intent(inout) :: self !! SyMBA test particle object + class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + logical :: lany_encounter !! Returns true if there is at least one close encounter + end function symba_encounter_check_tp + + pure module subroutine symba_gr_p4_pl(self, nbody_system, param, dt) + implicit none + class(symba_pl), 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 + real(DP), intent(in) :: dt !! Step size + end subroutine symba_gr_p4_pl + + pure module subroutine symba_gr_p4_tp(self, nbody_system, param, dt) + implicit none + class(symba_tp), intent(inout) :: self !! SyMBA 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 + real(DP), intent(in) :: dt !! Step size + end subroutine symba_gr_p4_tp + + module subroutine symba_util_set_renc(self, scale) + implicit none + class(symba_pl), intent(inout) :: self !! SyMBA massive body object + integer(I4B), intent(in) :: scale !! Current recursion depth + end subroutine symba_util_set_renc + + module subroutine symba_io_param_writer(self, unit, iotype, v_list, iostat, iomsg) + implicit none + class(swiftest_parameters),intent(in) :: self !! Current run configuration parameters with SyMBA additions + integer, 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, intent(in) :: v_list(:) !! Not used in this procedure + integer, intent(out) :: iostat !! IO status code + character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 + end subroutine symba_io_param_writer + + module subroutine symba_kick_getacch_int_pl(self, param) + implicit none + class(symba_pl), intent(inout) :: self !! SyMBA massive body object + class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters + end subroutine symba_kick_getacch_int_pl + + module subroutine symba_kick_getacch_pl(self, nbody_system, param, t, lbeg) + implicit none + class(symba_pl), intent(inout) :: self !! SyMBA 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 simulation time + logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step + end subroutine symba_kick_getacch_pl + + module subroutine symba_kick_getacch_tp(self, nbody_system, param, t, lbeg) + implicit none + class(symba_tp), intent(inout) :: self !! SyMBA test 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 !! Logical flag that determines whether or not this is the beginning or end of the step + end subroutine symba_kick_getacch_tp + + module subroutine symba_kick_list_plpl(self, nbody_system, dt, irec, sgn) + implicit none + class(symba_list_plpl), intent(in) :: self !! SyMBA pl-tp encounter list object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + integer(I4B), intent(in) :: sgn !! sign to be applied to acceleration + end subroutine symba_kick_list_plpl + + module subroutine symba_kick_list_pltp(self, nbody_system, dt, irec, sgn) + implicit none + class(symba_list_pltp), intent(in) :: self !! SyMBA pl-tp encounter list object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + integer(I4B), intent(in) :: sgn !! sign to be applied to acceleration + end subroutine symba_kick_list_pltp + + module subroutine symba_util_setup_initialize_system(self, param) + implicit none + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody_system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine symba_util_setup_initialize_system + + module subroutine symba_util_setup_pl(self, n, param) + implicit none + 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 parameters + end subroutine symba_util_setup_pl + + module subroutine symba_util_setup_tp(self, n, param) + implicit none + 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 + end subroutine symba_util_setup_tp + + module subroutine symba_step_system(self, param, t, dt) + implicit none + class(symba_nbody_system), intent(inout) :: self !! SyMBA 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 symba_step_system + + module subroutine symba_step_interp_system(self, param, t, dt) + implicit none + class(symba_nbody_system), intent(inout) :: self !! SyMBA 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 symba_step_interp_system + + module subroutine symba_step_set_recur_levels_system(self, ireci) + implicit none + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system objec + integer(I4B), intent(in) :: ireci !! Input recursion level + end subroutine symba_step_set_recur_levels_system + + recursive module subroutine symba_step_recur_system(self, param, t, ireci) + implicit none + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Current simulation time + integer(I4B), intent(in) :: ireci !! input recursion level + end subroutine symba_step_recur_system + + module subroutine symba_step_reset_system(self, param) + implicit none + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters with SyMBA additions + end subroutine symba_step_reset_system + + module subroutine symba_util_append_pl(self, source, lsource_mask) + implicit none + 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 + end subroutine symba_util_append_pl + + module subroutine symba_util_append_tp(self, source, lsource_mask) + implicit none + 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 + end subroutine symba_util_append_tp + + module subroutine symba_util_dealloc_pl(self) + implicit none + class(symba_pl), intent(inout) :: self !! SyMBA massive body object + end subroutine symba_util_dealloc_pl + + module subroutine symba_util_dealloc_tp(self) + implicit none + class(symba_tp), intent(inout) :: self !! SyMBA test particle object + end subroutine symba_util_dealloc_tp + end interface + + + interface + module subroutine symba_util_fill_pl(self, inserts, lfill_list) + implicit none + class(symba_pl), intent(inout) :: self !! SyMBA massive 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 + end subroutine symba_util_fill_pl + + module subroutine symba_util_fill_tp(self, inserts, lfill_list) + implicit none + 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 + end subroutine symba_util_fill_tp + + module subroutine symba_util_flatten_eucl_plpl(self, param) + implicit none + class(symba_pl), intent(inout) :: self !! SyMBA massive body object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine symba_util_flatten_eucl_plpl + + end interface + + interface + module subroutine symba_util_resize_pl(self, nnew) + implicit none + class(symba_pl), intent(inout) :: self !! SyMBA massive body object + integer(I4B), intent(in) :: nnew !! New size neded + end subroutine symba_util_resize_pl + + module subroutine symba_util_resize_tp(self, nnew) + implicit none + class(symba_tp), intent(inout) :: self !! SyMBA massive body object + integer(I4B), intent(in) :: nnew !! New size neded + end subroutine symba_util_resize_tp + + module subroutine symba_util_sort_pl(self, sortby, ascending) + implicit none + 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 + end subroutine symba_util_sort_pl + + module subroutine symba_util_sort_tp(self, sortby, ascending) + implicit none + 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 + end subroutine symba_util_sort_tp + end interface + + interface + module subroutine symba_util_sort_rearrange_pl(self, ind) + implicit none + 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) + end subroutine symba_util_sort_rearrange_pl + + module subroutine symba_util_sort_rearrange_tp(self, ind) + implicit none + class(symba_tp), 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) + end subroutine symba_util_sort_rearrange_tp + end interface + + interface + module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive) + implicit none + 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 the keeps array or not + end subroutine symba_util_spill_pl + + module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) + implicit none + 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 the keeps array or not + end subroutine symba_util_spill_tp + end interface + + + contains + + + subroutine symba_final_list_plpl(self) + !! author: David A. Minton + !! + !! Finalize the pl-tp list - deallocates all allocatables + implicit none + type(symba_list_plpl), intent(inout) :: self !! SyMBA encounter list object + + call self%dealloc() + + return + end subroutine symba_final_list_plpl + + + subroutine symba_final_list_pltp(self) + !! author: David A. Minton + !! + !! Finalize the pl-tp list - deallocates all allocatables + implicit none + type(symba_list_pltp), intent(inout) :: self !! SyMBA encounter list object + + call self%dealloc() + + return + end subroutine symba_final_list_pltp + + + subroutine symba_final_pl(self) + !! author: David A. Minton + !! + !! Finalize the SyMBA massive body object - deallocates all allocatables + implicit none + ! Argument + type(symba_pl), intent(inout) :: self !! SyMBA massive body object + + call self%dealloc() + + return + end subroutine symba_final_pl + + + subroutine symba_final_system(self) + !! author: David A. Minton + !! + !! Finalize the SyMBA nbody system object - deallocates all allocatables + implicit none + ! Argument + type(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object + + if (allocated(self%pl_adds)) deallocate(self%pl_adds) + if (allocated(self%pltp_encounter)) deallocate(self%pltp_encounter) + if (allocated(self%plpl_encounter)) deallocate(self%plpl_encounter) + if (allocated(self%plpl_collision)) deallocate(self%plpl_collision) + + call helio_final_system(self%helio_nbody_system) + + return + end subroutine symba_final_system + + + subroutine symba_final_tp(self) + !! author: David A. Minton + !! + !! Finalize the SyMBA test particleobject - deallocates all allocatables + implicit none + ! Argument + type(symba_tp), intent(inout) :: self !! SyMBA test particle object + + call self%dealloc() + + return + end subroutine symba_final_tp +end module symba \ No newline at end of file diff --git a/src/symba/symba_setup.f90 b/src/symba/symba_setup.f90 deleted file mode 100644 index 9187e4457..000000000 --- a/src/symba/symba_setup.f90 +++ /dev/null @@ -1,158 +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. - -submodule(symba_classes) s_symba_setup - use swiftest -contains - - module subroutine symba_setup_initialize_system(self, param) - !! author: David A. Minton - !! - !! Initialize an SyMBA nbody system from files and sets up the planetocentric structures. - !! This subroutine will also sort the massive bodies in descending order by mass - !! - implicit none - ! Arguments - class(symba_nbody_system), intent(inout) :: self !! SyMBA system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - - ! Call parent method - associate(system => self) - call helio_setup_initialize_system(system, param) - call system%pltpenc_list%setup(0_I8B) - call system%plplenc_list%setup(0_I8B) - call system%plplcollision_list%setup(0_I8B) - end associate - - return - end subroutine symba_setup_initialize_system - - - module subroutine symba_setup_merger(self, n, param) - !! author: David A. Minton - !! - !! Allocate SyMBA test particle structure - !! - !! Equivalent in functionality to David E. Kaufmann's Swifter routine symba_setup.f90 - implicit none - ! Arguments - class(symba_merger), intent(inout) :: self !! SyMBA merger list 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. In this case, helio_pl does not have its own setup method so we use the base method for swiftest_pl - call symba_setup_pl(self, n, param) - if (n < 0) return - - if (allocated(self%ncomp)) deallocate(self%ncomp) - - if (n == 0) return - - allocate(self%ncomp(n)) - self%ncomp(:) = 0 - - return - end subroutine symba_setup_merger - - - module subroutine symba_setup_pl(self, n, param) - !! author: David A. Minton - !! - !! Allocate SyMBA test particle structure - !! - !! Equivalent in functionality to David E. Kaufmann's Swifter routine symba_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 - ! Internals - integer(I4B) :: i - - !> Call allocation method for parent class. In this case, helio_pl does not have its own setup method so we use the base method for swiftest_pl - call setup_pl(self, n, param) - if (n == 0) return - - allocate(self%lcollision(n)) - allocate(self%lencounter(n)) - allocate(self%lmtiny(n)) - allocate(self%nplenc(n)) - allocate(self%ntpenc(n)) - allocate(self%levelg(n)) - allocate(self%levelm(n)) - allocate(self%isperi(n)) - allocate(self%peri(n)) - allocate(self%atp(n)) - allocate(self%kin(n)) - - self%lcollision(:) = .false. - self%lencounter(:) = .false. - self%lmtiny(:) = .false. - self%nplenc(:) = 0 - self%ntpenc(:) = 0 - self%levelg(:) = -1 - self%levelm(:) = -1 - self%isperi(:) = 0 - self%peri(:) = 0.0_DP - self%atp(:) = 0.0_DP - call self%reset_kinship([(i, i=1, n)]) - return - end subroutine symba_setup_pl - - - module subroutine symba_setup_encounter_list(self, n) - !! author: David A. Minton - !! - !! A constructor that sets the number of encounters and allocates and initializes all arrays - !! - implicit none - ! Arguments - class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter structure - integer(I8B), intent(in) :: n !! Number of encounters to allocate space for - - call encounter_setup_list(self, n) - if (n <= 0_I8B) return - - if (allocated(self%level)) deallocate(self%level) - allocate(self%level(n)) - - self%level(:) = -1 - - return - end subroutine symba_setup_encounter_list - - - module subroutine symba_setup_tp(self, n, param) - !! author: David A. Minton - !! - !! Allocate WHM test particle structure - !! - !! Equivalent in functionality to David E. Kaufmann's Swifter routine whm_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 - - !> Call allocation method for parent class. In this case, helio_tp does not have its own setup method so we use the base method for swiftest_tp - call setup_tp(self, n, param) - if (n == 0) return - - allocate(self%nplenc(n)) - allocate(self%levelg(n)) - allocate(self%levelm(n)) - - self%nplenc(:) = 0 - self%levelg(:) = -1 - self%levelm(:) = -1 - - return - end subroutine symba_setup_tp - -end submodule s_symba_setup diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index e24eeec31..fcbb734fd 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (symba_classes) s_symba_step +submodule (symba) s_symba_step use swiftest contains @@ -30,21 +30,23 @@ module subroutine symba_step_system(self, param, t, dt) select type(pl => self%pl) class is (symba_pl) - select type(tp => self%tp) - class is (symba_tp) - select type(param) - class is (symba_parameters) - call self%reset(param) - lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) - if (lencounter) then - call self%interp(param, t, dt) - else - self%irec = -1 - call helio_step_system(self, param, t, dt) - end if - param%lfirstkick = pl%lfirst - end select - end select + select type(tp => self%tp) + class is (symba_tp) + select type(param) + class is (swiftest_parameters) + call self%reset(param) + lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) + if (lencounter) then + if (param%lenc_save_trajectory) call self%encounter_history%take_snapshot(param, self, t, "trajectory") + call self%interp(param, t, dt) + if (param%lenc_save_trajectory) call self%encounter_history%take_snapshot(param, self, t+dt, "trajectory") + else + self%irec = -1 + call helio_step_system(self, param, t, dt) + end if + param%lfirstkick = pl%lfirst + end select + end select end select return @@ -68,47 +70,47 @@ module subroutine symba_step_interp_system(self, param, t, dt) ! Internals real(DP) :: dth !! Half step size - dth = 0.5_DP * dt - associate(system => self) - select type(pl => system%pl) - class is (symba_pl) - select type(tp => system%tp) - class is (symba_tp) - select type(cb => system%cb) - class is (symba_cb) - system%irec = -1 - if (pl%lfirst) call pl%vh2vb(cb) - call pl%lindrift(cb, dth, lbeg=.true.) - call pl%kick(system, param, t, dth, lbeg=.true.) - if (param%lgr) call pl%gr_pos_kick(system, param, dth) - call pl%drift(system, param, dt) - - if (tp%nbody > 0) then - if (tp%lfirst) call tp%vh2vb(vbcb = -cb%ptbeg) - call tp%lindrift(cb, dth, lbeg=.true.) - call tp%kick(system, param, t, dth, lbeg=.true.) - if (param%lgr) call tp%gr_pos_kick(system, param, dth) - call tp%drift(system, param, dt) - end if - - call system%recursive_step(param, t, 0) - system%irec = -1 - - if (param%lgr) call pl%gr_pos_kick(system, param, dth) - call pl%kick(system, param, t, dth, lbeg=.false.) - call pl%lindrift(cb, dth, lbeg=.false.) - call pl%vb2vh(cb) - - if (tp%nbody > 0) then - if (param%lgr) call tp%gr_pos_kick(system, param, dth) - call tp%kick(system, param, t, dth, lbeg=.false.) - call tp%lindrift(cb, dth, lbeg=.false.) - call tp%vb2vh(vbcb = -cb%ptend) - end if - end select - end select - end select - end associate + select type(pl => self%pl) + class is (symba_pl) + select type(tp => self%tp) + class is (symba_tp) + select type(cb => self%cb) + class is (symba_cb) + associate(nbody_system => self) + dth = 0.5_DP * dt + nbody_system%irec = -1 + if (pl%lfirst) call pl%vh2vb(cb) + call pl%lindrift(cb, dth, lbeg=.true.) + call pl%kick(nbody_system, param, t, dth, lbeg=.true.) + if (param%lgr) call pl%gr_pos_kick(nbody_system, param, dth) + call pl%drift(nbody_system, param, dt) + + if (tp%nbody > 0) then + if (tp%lfirst) call tp%vh2vb(vbcb = -cb%ptbeg) + call tp%lindrift(cb, dth, lbeg=.true.) + call tp%kick(nbody_system, param, t, dth, lbeg=.true.) + if (param%lgr) call tp%gr_pos_kick(nbody_system, param, dth) + call tp%drift(nbody_system, param, dt) + end if + + call nbody_system%recursive_step(param, t, 0) + nbody_system%irec = -1 + + if (param%lgr) call pl%gr_pos_kick(nbody_system, param, dth) + call pl%kick(nbody_system, param, t, dth, lbeg=.false.) + call pl%lindrift(cb, dth, lbeg=.false.) + call pl%vb2vh(cb) + + if (tp%nbody > 0) then + if (param%lgr) call tp%gr_pos_kick(nbody_system, param, dth) + call tp%kick(nbody_system, param, t, dth, lbeg=.false.) + call tp%lindrift(cb, dth, lbeg=.false.) + call tp%vb2vh(vbcb = -cb%ptend) + end if + end associate + end select + end select + end select return end subroutine symba_step_interp_system @@ -128,32 +130,32 @@ module subroutine symba_step_set_recur_levels_system(self, ireci) ! Internals integer(I4B) :: irecp - associate(system => self, plplenc_list => self%plplenc_list, pltpenc_list => self%pltpenc_list, & - npl => self%pl%nbody, ntp => self%tp%nbody) - select type(pl => self%pl) - class is (symba_pl) - select type(tp => self%tp) - class is (symba_tp) - irecp = ireci + 1 - - if (npl >0) where(pl%levelg(1:npl) == irecp) pl%levelg(1:npl) = ireci - if (ntp > 0) where(tp%levelg(1:ntp) == irecp) tp%levelg(1:ntp) = ireci - if (plplenc_list%nenc > 0) then - where(plplenc_list%level(1:plplenc_list%nenc) == irecp) - plplenc_list%level(1:plplenc_list%nenc) = ireci - endwhere - end if - if (pltpenc_list%nenc > 0) then - where(pltpenc_list%level(1:pltpenc_list%nenc) == irecp) - pltpenc_list%level(1:pltpenc_list%nenc) = ireci - endwhere - end if - - system%irec = ireci - - end select - end select - end associate + select type(pl => self%pl) + class is (symba_pl) + select type(tp => self%tp) + class is (symba_tp) + associate(nbody_system => self, plpl_encounter => self%plpl_encounter, pltp_encounter => self%pltp_encounter, npl => self%pl%nbody, ntp => self%tp%nbody) + + irecp = ireci + 1 + + if (npl >0) where(pl%levelg(1:npl) == irecp) pl%levelg(1:npl) = ireci + if (ntp > 0) where(tp%levelg(1:ntp) == irecp) tp%levelg(1:ntp) = ireci + if (plpl_encounter%nenc > 0) then + where(plpl_encounter%level(1:plpl_encounter%nenc) == irecp) + plpl_encounter%level(1:plpl_encounter%nenc) = ireci + endwhere + end if + if (pltp_encounter%nenc > 0) then + where(pltp_encounter%level(1:pltp_encounter%nenc) == irecp) + pltp_encounter%level(1:pltp_encounter%nenc) = ireci + endwhere + end if + + nbody_system%irec = ireci + + end associate + end select + end select return end subroutine symba_step_set_recur_levels_system @@ -176,76 +178,86 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) ! Internals integer(I4B) :: j, irecp, nloops real(DP) :: dtl, dth - logical :: lencounter, lplpl_collision, lpltp_collision - - associate(system => self, plplenc_list => self%plplenc_list, pltpenc_list => self%pltpenc_list) - select type(pl => self%pl) - class is (symba_pl) - select type(tp => self%tp) - class is (symba_tp) - system%irec = ireci - dtl = param%dt / (NTENC**ireci) - dth = 0.5_DP * dtl - IF (dtl / param%dt < VSMALL) THEN - write(*, *) "SWIFTEST Warning:" - write(*, *) " In symba_step_recur_system, local time step is too small" - write(*, *) " Roundoff error will be important!" - call util_exit(FAILURE) - END IF - irecp = ireci + 1 - if (ireci == 0) then - nloops = 1 - else - nloops = NTENC + logical :: lencounter + + select type(param) + class is (swiftest_parameters) + select type(pl => self%pl) + class is (symba_pl) + select type(tp => self%tp) + class is (symba_tp) + select type(plpl_encounter => self%plpl_encounter) + class is (symba_list_plpl) + select type(pltp_encounter => self%pltp_encounter) + class is (symba_list_pltp) + associate(nbody_system => self, lplpl_collision => plpl_encounter%lcollision, lpltp_collision => pltp_encounter%lcollision) + nbody_system%irec = ireci + dtl = param%dt / (NTENC**ireci) + dth = 0.5_DP * dtl + IF (dtl / param%dt < VSMALL) THEN + write(*, *) "SWIFTEST Warning:" + write(*, *) " In symba_step_recur_system, local time step is too small" + write(*, *) " Roundoff error will be important!" + call util_exit(FAILURE) + END IF + irecp = ireci + 1 + if (ireci == 0) then + nloops = 1 + else + nloops = NTENC + end if + do j = 1, nloops + lencounter = plpl_encounter%encounter_check(param, nbody_system, dtl, irecp) & + .or. pltp_encounter%encounter_check(param, nbody_system, dtl, irecp) + + call plpl_encounter%kick(nbody_system, dth, irecp, 1) + call pltp_encounter%kick(nbody_system, dth, irecp, 1) + if (ireci /= 0) then + call plpl_encounter%kick(nbody_system, dth, irecp, -1) + call pltp_encounter%kick(nbody_system, dth, irecp, -1) end if - do j = 1, nloops - lencounter = plplenc_list%encounter_check(param, system, dtl, irecp) & - .or. pltpenc_list%encounter_check(param, system, dtl, irecp) - - call plplenc_list%kick(system, dth, irecp, 1) - call pltpenc_list%kick(system, dth, irecp, 1) - if (ireci /= 0) then - call plplenc_list%kick(system, dth, irecp, -1) - call pltpenc_list%kick(system, dth, irecp, -1) - end if - - if (param%lgr) then - call pl%gr_pos_kick(system, param, dth) - call tp%gr_pos_kick(system, param, dth) - end if - - call pl%drift(system, param, dtl) - call tp%drift(system, param, dtl) - - if (lencounter) call system%recursive_step(param, t+dth,irecp) - system%irec = ireci - - if (param%lgr) then - call pl%gr_pos_kick(system, param, dth) - call tp%gr_pos_kick(system, param, dth) - end if - - call plplenc_list%kick(system, dth, irecp, 1) - call pltpenc_list%kick(system, dth, irecp, 1) - if (ireci /= 0) then - call plplenc_list%kick(system, dth, irecp, -1) - call pltpenc_list%kick(system, dth, irecp, -1) - end if - - if (param%lclose) then - lplpl_collision = plplenc_list%collision_check(system, param, t+dtl, dtl, ireci) - lpltp_collision = pltpenc_list%collision_check(system, param, t+dtl, dtl, ireci) - - if (lplpl_collision) call plplenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) - if (lpltp_collision) call pltpenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) - end if - - call self%set_recur_levels(ireci) - - end do - end select - end select - end associate + + if (param%lgr) then + call pl%gr_pos_kick(nbody_system, param, dth) + call tp%gr_pos_kick(nbody_system, param, dth) + end if + + call pl%drift(nbody_system, param, dtl) + call tp%drift(nbody_system, param, dtl) + + if (lencounter) call nbody_system%recursive_step(param, t+(j-1)*dtl, irecp) + nbody_system%irec = ireci + + if (param%lgr) then + call pl%gr_pos_kick(nbody_system, param, dth) + call tp%gr_pos_kick(nbody_system, param, dth) + end if + + call plpl_encounter%kick(nbody_system, dth, irecp, 1) + call pltp_encounter%kick(nbody_system, dth, irecp, 1) + if (ireci /= 0) then + call plpl_encounter%kick(nbody_system, dth, irecp, -1) + call pltp_encounter%kick(nbody_system, dth, irecp, -1) + end if + + if (param%lclose) then + call plpl_encounter%collision_check(nbody_system, param, t+j*dtl, dtl, ireci, lplpl_collision) + call pltp_encounter%collision_check(nbody_system, param, t+j*dtl, dtl, ireci, lpltp_collision) + + if (lplpl_collision) call plpl_encounter%resolve_collision(nbody_system, param, t+j*dtl, dtl, ireci) + if (lpltp_collision) call pltp_encounter%resolve_collision(nbody_system, param, t+j*dtl, dtl, ireci) + end if + if (param%lenc_save_trajectory) call self%encounter_history%take_snapshot(param, self, t+j*dtl, "trajectory") + + call self%set_recur_levels(ireci) + + end do + end associate + end select + end select + end select + end select + end select return end subroutine symba_step_recur_system @@ -261,56 +273,59 @@ module subroutine symba_step_reset_system(self, param) implicit none ! Arguments class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(symba_parameters), intent(in) :: param !! Current run configuration parameters with SyMBA additions + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters with SyMBA additions ! Internals integer(I4B) :: i integer(I8B) :: nenc_old - associate(system => self) - select type(pl => system%pl) - class is (symba_pl) - select type(tp => system%tp) - class is (symba_tp) - associate(npl => pl%nbody, ntp => tp%nbody) - nenc_old = system%plplenc_list%nenc - call system%plplenc_list%setup(0_I8B) - call system%plplcollision_list%setup(0_I8B) - if (npl > 0) then - pl%lcollision(1:npl) = .false. - call pl%reset_kinship([(i, i=1, npl)]) - pl%nplenc(1:npl) = 0 - pl%ntpenc(1:npl) = 0 - pl%levelg(1:npl) = -1 - pl%levelm(1:npl) = -1 - pl%lencounter(1:npl) = .false. - pl%lcollision(1:npl) = .false. - pl%ldiscard(1:npl) = .false. - pl%lmask(1:npl) = .true. - call pl%set_renc(0) - call system%plplenc_list%setup(nenc_old) ! This resizes the pl-pl encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step - system%plplenc_list%nenc = 0 ! Sets the true number of encounters back to 0 after resizing - end if - - nenc_old = system%pltpenc_list%nenc - call system%pltpenc_list%setup(0_I8B) - if (ntp > 0) then - tp%nplenc(1:ntp) = 0 - tp%levelg(1:ntp) = -1 - tp%levelm(1:ntp) = -1 - tp%lmask(1:ntp) = .true. - tp%ldiscard(1:ntp) = .false. - call system%pltpenc_list%setup(nenc_old)! This resizes the pl-tp encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step - system%pltpenc_list%nenc = 0 ! Sets the true number of encounters back to 0 after resizing - end if - - call system%pl_adds%setup(0, param) - call system%pl_discards%setup(0, param) - - tp%lfirst = param%lfirstkick - pl%lfirst = param%lfirstkick - end associate - end select - end select + associate(nbody_system => self) + select type(pl => nbody_system%pl) + class is (symba_pl) + select type(tp => nbody_system%tp) + class is (symba_tp) + associate(npl => pl%nbody, ntp => tp%nbody) + nenc_old = nbody_system%plpl_encounter%nenc + call nbody_system%plpl_encounter%setup(0_I8B) + call nbody_system%plpl_collision%setup(0_I8B) + if (npl > 0) then + pl%lcollision(1:npl) = .false. + call pl%reset_kinship([(i, i=1, npl)]) + pl%nplenc(1:npl) = 0 + pl%ntpenc(1:npl) = 0 + pl%levelg(1:npl) = -1 + pl%levelm(1:npl) = -1 + pl%lencounter(1:npl) = .false. + pl%lcollision(1:npl) = .false. + pl%ldiscard(1:npl) = .false. + pl%lmask(1:npl) = .true. + call pl%set_renc(0) + call nbody_system%plpl_encounter%setup(nenc_old) ! This resizes the pl-pl encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step + nbody_system%plpl_encounter%nenc = 0 ! Sets the true number of encounters back to 0 after resizing + nbody_system%plpl_encounter%lcollision = .false. + end if + + nenc_old = nbody_system%pltp_encounter%nenc + call nbody_system%pltp_encounter%setup(0_I8B) + if (ntp > 0) then + tp%nplenc(1:ntp) = 0 + tp%levelg(1:ntp) = -1 + tp%levelm(1:ntp) = -1 + tp%lmask(1:ntp) = .true. + tp%ldiscard(1:ntp) = .false. + call nbody_system%pltp_encounter%setup(nenc_old)! This resizes the pl-tp encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step + nbody_system%pltp_encounter%nenc = 0 ! Sets the true number of encounters back to 0 after resizing + nbody_system%pltp_encounter%lcollision = .false. + end if + + call nbody_system%pl_adds%setup(0, param) + call nbody_system%pl_discards%setup(0, param) + + tp%lfirst = param%lfirstkick + pl%lfirst = param%lfirstkick + + end associate + end select + end select end associate return diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 8d110451f..0a78693b2 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -7,64 +7,10 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(symba_classes) s_symba_util +submodule(symba) s_symba_util use swiftest contains - - module subroutine symba_util_append_arr_kin(arr, source, nold, nsrc, lsource_mask) - !! author: David A. Minton - !! - !! Append a single array of kinship type onto another. If the destination array is not allocated, or is not big enough, this will allocate space for it. - implicit none - ! Arguments - type(symba_kinship), dimension(:), allocatable, intent(inout) :: arr !! Destination array - type(symba_kinship), dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - ! Internals - integer(I4B) :: nnew - - if (.not. allocated(source)) return - - nnew = count(lsource_mask(1:nsrc)) - if (.not.allocated(arr)) then - allocate(arr(nold+nnew)) - else - call util_resize(arr, nold + nnew) - end if - - arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) - - return - end subroutine symba_util_append_arr_kin - - - module subroutine symba_util_append_encounter_list(self, source, lsource_mask) - !! author: David A. Minton - !! - !! Append components from one encounter list (pl-pl or pl-tp) body object to another. - !! This method will automatically resize the destination body if it is too small - implicit none - ! Arguments - class(symba_encounter), intent(inout) :: self !! SyMBA encounter list object - class(encounter_list), intent(in) :: source !! Source object to append - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - ! Internals - integer(I4B) :: nold, nsrc - - nold = self%nenc - nsrc = source%nenc - select type(source) - class is (symba_encounter) - call util_append(self%level, source%level, nold, nsrc, lsource_mask) - end select - call encounter_util_append_list(self, source, lsource_mask) - - return - end subroutine symba_util_append_encounter_list - - module subroutine symba_util_append_pl(self, source, lsource_mask) !! author: David A. Minton !! @@ -79,19 +25,10 @@ module subroutine symba_util_append_pl(self, source, lsource_mask) select type(source) class is (symba_pl) associate(nold => self%nbody, nsrc => source%nbody) - call util_append(self%lcollision, source%lcollision, nold, nsrc, lsource_mask) - call util_append(self%lencounter, source%lencounter, nold, nsrc, lsource_mask) - call util_append(self%lmtiny, source%lmtiny, nold, nsrc, lsource_mask) - call util_append(self%nplenc, source%nplenc, nold, nsrc, lsource_mask) - call util_append(self%ntpenc, source%ntpenc, nold, nsrc, lsource_mask) - call util_append(self%levelg, source%levelg, nold, nsrc, lsource_mask) - call util_append(self%levelm, source%levelm, nold, nsrc, lsource_mask) - call util_append(self%isperi, source%isperi, nold, nsrc, lsource_mask) - call util_append(self%peri, source%peri, nold, nsrc, lsource_mask) - call util_append(self%atp, source%atp, nold, nsrc, lsource_mask) - call util_append(self%kin, source%kin, nold, nsrc, lsource_mask) - - call 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 + call swiftest_util_append(self%levelg, source%levelg, nold, nsrc, lsource_mask) + call swiftest_util_append(self%levelm, source%levelm, nold, nsrc, 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 end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class symba_pl or its descendents!" @@ -102,45 +39,6 @@ module subroutine symba_util_append_pl(self, source, lsource_mask) end subroutine symba_util_append_pl - module subroutine symba_util_append_merger(self, source, lsource_mask) - !! author: David A. Minton - !! - !! Append components from one massive body object to another. - !! This method will automatically resize the destination body if it is too small - implicit none - ! Arguments - class(symba_merger), 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 - ! Internals - integer(I4B), dimension(:), allocatable :: ncomp_tmp !! Temporary placeholder for ncomp incase we are appending a symba_pl object to a symba_merger - integer(I4B) :: nold, nsrc, nnew - - nold = self%nbody - nsrc = source%nbody - nnew = count(lsource_mask) - - select type(source) - class is (symba_merger) - call util_append(self%ncomp, source%ncomp, nold, nsrc, lsource_mask) - call symba_util_append_pl(self, source, lsource_mask) - class is (symba_pl) - allocate(ncomp_tmp, mold=source%id) - ncomp_tmp(:) = 0 - call util_append(self%ncomp, ncomp_tmp, nold, nsrc, lsource_mask) - call symba_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 util_exit(FAILURE) - end select - - ! Save the number of appended bodies - self%ncomp(nold+1:nold+nnew) = nnew - - return - end subroutine symba_util_append_merger - - module subroutine symba_util_append_tp(self, source, lsource_mask) !! author: David A. Minton !! @@ -155,11 +53,10 @@ module subroutine symba_util_append_tp(self, source, lsource_mask) select type(source) class is (symba_tp) associate(nold => self%nbody, nsrc => source%nbody) - call util_append(self%nplenc, source%nplenc, nold, nsrc, lsource_mask) - call util_append(self%levelg, source%levelg, nold, nsrc, lsource_mask) - call util_append(self%levelm, source%levelm, nold, nsrc, lsource_mask) + call swiftest_util_append(self%levelg, source%levelg, nold, nsrc, lsource_mask) + call swiftest_util_append(self%levelm, source%levelm, nold, nsrc, lsource_mask) - call 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 + 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 end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class symba_tp or its descendents!" @@ -170,91 +67,6 @@ module subroutine symba_util_append_tp(self, source, lsource_mask) end subroutine symba_util_append_tp - module subroutine symba_util_copy_encounter_list(self, source) - !! author: David A. Minton - !! - !! Copies elements from the source encounter list into self. - implicit none - ! Arguments - class(symba_encounter), intent(inout) :: self !! Encounter list - class(encounter_list), intent(in) :: source !! Source object to copy into - - select type(source) - class is (symba_encounter) - associate(n => source%nenc) - self%level(1:n) = source%level(1:n) - end associate - end select - - call encounter_util_copy_list(self, source) - - return - end subroutine symba_util_copy_encounter_list - - - module subroutine symba_util_dealloc_encounter_list(self) - !! author: David A. Minton - !! - !! Deallocates all allocatabale arrays - implicit none - ! Argumentse - class(symba_encounter), intent(inout) :: self !! SyMBA encounter list - - if (allocated(self%level)) deallocate(self%level) - - return - end subroutine symba_util_dealloc_encounter_list - - - module subroutine symba_util_dealloc_kin(self) - !! author: David A. Minton - !! - !! Deallocates all allocatabale arrays - implicit none - ! Arguments - class(symba_kinship), intent(inout) :: self !! SyMBA kinship object - - if (allocated(self%child)) deallocate(self%child) - - return - end subroutine symba_util_dealloc_kin - - - module subroutine symba_util_dealloc_merger(self) - !! author: David A. Minton - !! - !! Deallocates all allocatabale arrays - implicit none - ! Arguments - class(symba_merger), intent(inout) :: self !! SyMBA body merger object - - if (allocated(self%ncomp)) deallocate(self%ncomp) - - call symba_util_dealloc_pl(self) - - return - end subroutine symba_util_dealloc_merger - - - module subroutine symba_util_dealloc_system(self) - !! author: David A. Minton - !! - !! Deallocates all allocatabale arrays - implicit none - ! Arguments - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - - if (allocated(self%pl_adds)) deallocate(self%pl_adds) - if (allocated(self%pltpenc_list)) deallocate(self%pltpenc_list) - if (allocated(self%plplenc_list)) deallocate(self%plplenc_list) - if (allocated(self%plplcollision_list)) deallocate(self%plplcollision_list) - - call util_dealloc_system(self) - - return - end subroutine symba_util_dealloc_system - - module subroutine symba_util_dealloc_pl(self) !! author: David A. Minton !! @@ -265,25 +77,10 @@ module subroutine symba_util_dealloc_pl(self) ! Internals integer(I4B) :: i - if (allocated(self%lcollision)) deallocate(self%lcollision) - if (allocated(self%lencounter)) deallocate(self%lencounter) - if (allocated(self%lmtiny)) deallocate(self%lmtiny) - if (allocated(self%nplenc)) deallocate(self%nplenc) - if (allocated(self%ntpenc)) deallocate(self%ntpenc) if (allocated(self%levelg)) deallocate(self%levelg) if (allocated(self%levelm)) deallocate(self%levelm) - if (allocated(self%isperi)) deallocate(self%isperi) - if (allocated(self%peri)) deallocate(self%peri) - if (allocated(self%atp)) deallocate(self%atp) - if (allocated(self%kin)) then - do i = 1, self%nbody - call self%kin(i)%dealloc() - end do - deallocate(self%kin) - end if - - call util_dealloc_pl(self) + call self%helio_pl%dealloc() return end subroutine symba_util_dealloc_pl @@ -297,36 +94,15 @@ module subroutine symba_util_dealloc_tp(self) ! Arguments class(symba_tp), intent(inout) :: self !! SyMBA test particle object - if (allocated(self%nplenc)) deallocate(self%nplenc) if (allocated(self%levelg)) deallocate(self%levelg) if (allocated(self%levelm)) deallocate(self%levelm) - call util_dealloc_tp(self) + call self%helio_tp%dealloc() return end subroutine symba_util_dealloc_tp - module subroutine symba_util_fill_arr_kin(keeps, inserts, lfill_list) - !! author: David A. Minton - !! - !! Performs a fill operation on a single array of particle kinship types - !! This is the inverse of a spill operation - implicit none - ! Arguments - type(symba_kinship), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - type(symba_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 - - if (.not.allocated(keeps) .or. .not.allocated(inserts)) return - - keeps(:) = unpack(keeps(:), .not.lfill_list(:), keeps(:)) - keeps(:) = unpack(inserts(:), lfill_list(:), keeps(:)) - - return - end subroutine symba_util_fill_arr_kin - - module subroutine symba_util_fill_pl(self, inserts, lfill_list) !! author: David A. Minton !! @@ -342,19 +118,10 @@ module subroutine symba_util_fill_pl(self, inserts, lfill_list) associate(keeps => self) select type(inserts) class is (symba_pl) - call util_fill(keeps%lcollision, inserts%lcollision, lfill_list) - call util_fill(keeps%lencounter, inserts%lencounter, lfill_list) - call util_fill(keeps%lmtiny, inserts%lmtiny, lfill_list) - call util_fill(keeps%nplenc, inserts%nplenc, lfill_list) - call util_fill(keeps%ntpenc, inserts%ntpenc, lfill_list) - call util_fill(keeps%levelg, inserts%levelg, lfill_list) - call util_fill(keeps%levelm, inserts%levelm, lfill_list) - call util_fill(keeps%isperi, inserts%isperi, lfill_list) - call util_fill(keeps%peri, inserts%peri, lfill_list) - call util_fill(keeps%atp, inserts%atp, lfill_list) - call util_fill(keeps%kin, inserts%kin, lfill_list) - - call 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 + call swiftest_util_fill(keeps%levelg, inserts%levelg, lfill_list) + call swiftest_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 class default write(*,*) "Invalid object passed to the fill method. Source must be of class symba_pl or its descendents!" call util_exit(FAILURE) @@ -380,11 +147,11 @@ module subroutine symba_util_fill_tp(self, inserts, lfill_list) 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(keeps%nplenc, inserts%nplenc, lfill_list) + call swiftest_util_fill(keeps%levelg, inserts%levelg, lfill_list) + call swiftest_util_fill(keeps%levelm, inserts%levelm, lfill_list) - call 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 + 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 class default write(*,*) "Invalid object passed to the fill method. Source must be of class symba_tp or its descendents!" call util_exit(FAILURE) @@ -415,511 +182,155 @@ module subroutine symba_util_flatten_eucl_plpl(self, param) associate(pl => self, nplplm => self%nplplm) npl = int(self%nbody, kind=I8B) - select type(param) - class is (symba_parameters) + if (param%lmtiny_pl) then pl%lmtiny(1:npl) = pl%Gmass(1:npl) < param%GMTINY - end select - nplm = count(.not. pl%lmtiny(1:npl)) + nplm = count(.not. pl%lmtiny(1:npl)) + else + 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 - call util_flatten_eucl_plpl(pl, param) + call swiftest_util_flatten_eucl_plpl(pl, param) end associate return end subroutine symba_util_flatten_eucl_plpl - module subroutine symba_util_final_encounter_list(self) - !! author: David A. Minton - !! - !! Finalize the SyMBA encounter list object - deallocates all allocatables - implicit none - ! Argument - type(symba_encounter), intent(inout) :: self !! SyMBA encounter list object - - call self%dealloc() - - return - end subroutine symba_util_final_encounter_list - - module subroutine symba_util_final_kin(self) - !! author: David A. Minton - !! - !! Finalize the SyMBA kinship object - deallocates all allocatables - implicit none - ! Argument - type(symba_kinship), intent(inout) :: self !! SyMBA kinship object - - call self%dealloc() - - return - end subroutine symba_util_final_kin - - module subroutine symba_util_final_merger(self) + module subroutine symba_util_resize_pl(self, nnew) !! author: David A. Minton !! - !! Finalize the SyMBA merger object - deallocates all allocatables + !! Checks the current size of a SyMBA massive body object against the requested size and resizes it if it is too small. implicit none - ! Argument - type(symba_merger), intent(inout) :: self !! SyMBA merger object - - call self%dealloc() - - return - end subroutine symba_util_final_merger + ! Arguments + class(symba_pl), intent(inout) :: self !! SyMBA massive body object + integer(I4B), intent(in) :: nnew !! New size neded - module subroutine symba_util_final_pl(self) - !! author: David A. Minton - !! - !! Finalize the SyMBA massive body object - deallocates all allocatables - implicit none - ! Argument - type(symba_pl), intent(inout) :: self !! SyMBA massive body object + call swiftest_util_resize(self%levelg, nnew) + call swiftest_util_resize(self%levelm, nnew) - call self%dealloc() + call swiftest_util_resize_pl(self, nnew) return - end subroutine symba_util_final_pl + end subroutine symba_util_resize_pl - module subroutine symba_util_final_system(self) + module subroutine symba_util_resize_tp(self, nnew) !! author: David A. Minton !! - !! Finalize the SyMBA nbody system object - deallocates all allocatables + !! Checks the current size of a test particle object against the requested size and resizes it if it is too small. implicit none - ! Argument - type(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - - call self%dealloc() - - return - end subroutine symba_util_final_system + ! Arguments + class(symba_tp), intent(inout) :: self !! SyMBA test particle object + integer(I4B), intent(in) :: nnew !! New size neded - module subroutine symba_util_final_tp(self) - !! author: David A. Minton - !! - !! Finalize the SyMBA test particleobject - deallocates all allocatables - implicit none - ! Argument - type(symba_tp), intent(inout) :: self !! SyMBA test particle object + call swiftest_util_resize(self%levelg, nnew) + call swiftest_util_resize(self%levelm, nnew) - call self%dealloc() + call swiftest_util_resize_tp(self, nnew) return - end subroutine symba_util_final_tp - + end subroutine symba_util_resize_tp - module subroutine symba_util_peri_pl(self, system, param) + + module subroutine symba_util_set_renc(self, scale) !! author: David A. Minton !! - !! Determine system pericenter passages for planets in SyMBA + !! Sets the critical radius for encounter given an input recursion depth !! - !! Adapted from David E. Kaufmann's Swifter routine: symba_peri.f90 - !! Adapted from Hal Levison's Swift routine util_mass_peri.f implicit none ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + class(symba_pl), intent(inout) :: self !! SyMBA massive body object + integer(I4B), intent(in) :: scale !! Current recursion depth ! Internals - integer(I4B) :: i - real(DP) :: vdotr, e + integer(I4B) :: i + real(DP) :: rshell_irec associate(pl => self, npl => self%nbody) - if (pl%lfirst) then - if (param%qmin_coord == "HELIO") then - do i = 1, npl - if (pl%status(i) == ACTIVE) then - vdotr = dot_product(pl%xh(:,i), pl%vh(:,i)) - if (vdotr > 0.0_DP) then - pl%isperi(i) = 1 - else - pl%isperi(i) = -1 - end if - end if - end do - else - do i = 1, npl - if (pl%status(i) == ACTIVE) then - vdotr = dot_product(pl%xb(:,i), pl%vb(:,i)) - if (vdotr > 0.0_DP) then - pl%isperi(i) = 1 - else - pl%isperi(i) = -1 - end if - end if - end do - end if - else - if (param%qmin_coord == "HELIO") then - do i = 1, npl - if (pl%status(i) == ACTIVE) then - vdotr = dot_product(pl%xh(:,i), pl%vh(:,i)) - if (pl%isperi(i) == -1) then - if (vdotr >= 0.0_DP) then - pl%isperi(i) = 0 - CALL orbel_xv2aeq(pl%mu(i), pl%xh(1,i), pl%xh(2,i), pl%xh(3,i), pl%vh(1,i), pl%vh(2,i), pl%vh(3,i), & - pl%atp(i), e, pl%peri(i)) - end if - else - if (vdotr > 0.0_DP) then - pl%isperi(i) = 1 - else - pl%isperi(i) = -1 - end if - end if - end if - end do - else - do i = 1, npl - if (pl%status(i) == ACTIVE) then - vdotr = dot_product(pl%xb(:,i), pl%vb(:,i)) - if (pl%isperi(i) == -1) then - if (vdotr >= 0.0_DP) then - pl%isperi(i) = 0 - CALL orbel_xv2aeq(system%Gmtot, pl%xb(1,i), pl%xb(2,i), pl%xb(3,i), pl%vb(1,i), pl%vb(2,i), pl%vb(3,i),& - pl%atp(i), e, pl%peri(i)) - end if - else - if (vdotr > 0.0_DP) then - pl%isperi(i) = 1 - else - pl%isperi(i) = -1 - end if - end if - end if - end do - end if - end if - end associate - - return - end subroutine symba_util_peri_pl - - - module subroutine symba_util_rearray_pl(self, system, param) - !! Author: the Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Clean up the massive body structures to remove discarded bodies and add new bodies - implicit none - ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - class(symba_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - class(symba_pl), allocatable :: tmp !! The discarded body list. - integer(I4B) :: i, k, npl, nadd, nencmin, nenc_old, idnew1, idnew2, idold1, idold2 - logical, dimension(:), allocatable :: lmask, ldump_mask - class(symba_plplenc), allocatable :: plplenc_old - logical :: lencounter - integer(I4B), dimension(:), allocatable :: levelg_orig_pl, levelm_orig_pl, levelg_orig_tp, levelm_orig_tp - integer(I4B), dimension(:), allocatable :: nplenc_orig_pl, nplenc_orig_tp, ntpenc_orig_pl - - associate(pl => self, pl_adds => system%pl_adds) - - npl = pl%nbody - nadd = pl_adds%nbody - if (npl == 0) return - ! Deallocate any temporary variables - if (allocated(pl%xbeg)) deallocate(pl%xbeg) - if (allocated(pl%xend)) deallocate(pl%xend) - - ! Remove the discards and destroy the list, as the system already tracks pl_discards elsewhere - allocate(lmask(npl)) - lmask(1:npl) = pl%ldiscard(1:npl) - if (count(lmask(:)) > 0) then - allocate(tmp, mold=self) - call pl%spill(tmp, lspill_list=lmask, ldestructive=.true.) - npl = pl%nbody - call tmp%setup(0,param) - deallocate(tmp) - deallocate(lmask) - end if - - ! Store the original plplenc list so we don't remove any of the original encounters - nenc_old = system%plplenc_list%nenc - if (nenc_old > 0) then - allocate(plplenc_old, source=system%plplenc_list) - call plplenc_old%copy(system%plplenc_list) - end if - - ! Add in any new bodies - if (nadd > 0) then - ! Append the adds to the main pl object - call pl%append(pl_adds, lsource_mask=[(.true., i=1, nadd)]) - - allocate(ldump_mask(npl+nadd)) ! This mask is used only to append the original Fortran binary particle.dat file with new bodies. This is ignored for NetCDF output - ldump_mask(1:npl) = .false. - ldump_mask(npl+1:npl+nadd) = pl%status(npl+1:npl+nadd) == NEW_PARTICLE - npl = pl%nbody - else - allocate(ldump_mask(npl)) - ldump_mask(:) = .false. - end if - - ! Reset all of the status flags for this body - pl%status(1:npl) = ACTIVE - do i = 1, npl - call pl%info(i)%set_value(status="ACTIVE") + rshell_irec = 1._DP + do i = 1, scale + rshell_irec = rshell_irec * RSHELL end do - pl%ldiscard(1:npl) = .false. - pl%lcollision(1:npl) = .false. - pl%lmask(1:npl) = .true. - - select type(param) - class is (symba_parameters) - pl%lmtiny(1:npl) = pl%Gmass(1:npl) < param%GMTINY - where(pl%lmtiny(1:npl)) - pl%info(1:npl)%particle_type = PL_TINY_TYPE_NAME - elsewhere - pl%info(1:npl)%particle_type = PL_TYPE_NAME - end where - end select - - call pl%dump_particle_info(param, idx=pack([(i, i=1, npl)], ldump_mask)) - deallocate(ldump_mask) - - ! Reindex the new list of bodies - call pl%sort("mass", ascending=.false.) - call pl%flatten(param) - - ! Reset the kinship trackers - call pl%reset_kinship([(i, i=1, npl)]) - - ! Re-build the zero-level encounter list, being sure to save the original level information for all bodies - allocate(levelg_orig_pl, source=pl%levelg) - allocate(levelm_orig_pl, source=pl%levelm) - allocate(nplenc_orig_pl, source=pl%nplenc) - lencounter = pl%encounter_check(param, system, param%dt, 0) - if (system%tp%nbody > 0) then - select type(tp => system%tp) - class is (symba_tp) - allocate(ntpenc_orig_pl, source=pl%ntpenc) - allocate(levelg_orig_tp, source=tp%levelg) - allocate(levelm_orig_tp, source=tp%levelm) - allocate(nplenc_orig_tp, source=tp%nplenc) - lencounter = tp%encounter_check(param, system, param%dt, 0) - call move_alloc(levelg_orig_tp, tp%levelg) - call move_alloc(levelm_orig_tp, tp%levelm) - call move_alloc(nplenc_orig_tp, tp%nplenc) - call move_alloc(ntpenc_orig_pl, pl%ntpenc) - end select - end if - call move_alloc(levelg_orig_pl, pl%levelg) - call move_alloc(levelm_orig_pl, pl%levelm) - call move_alloc(nplenc_orig_pl, pl%nplenc) - - ! Re-index the encounter list as the index values may have changed - if (nenc_old > 0) then - nencmin = min(system%plplenc_list%nenc, plplenc_old%nenc) - system%plplenc_list%nenc = nencmin - do k = 1, nencmin - idnew1 = system%plplenc_list%id1(k) - idnew2 = system%plplenc_list%id2(k) - idold1 = plplenc_old%id1(k) - idold2 = plplenc_old%id2(k) - if ((idnew1 == idold1) .and. (idnew2 == idold2)) then - ! This is an encounter we already know about, so save the old information - system%plplenc_list%lvdotr(k) = plplenc_old%lvdotr(k) - system%plplenc_list%status(k) = plplenc_old%status(k) - system%plplenc_list%x1(:,k) = plplenc_old%x1(:,k) - system%plplenc_list%x2(:,k) = plplenc_old%x2(:,k) - system%plplenc_list%v1(:,k) = plplenc_old%v1(:,k) - system%plplenc_list%v2(:,k) = plplenc_old%v2(:,k) - system%plplenc_list%t(k) = plplenc_old%t(k) - system%plplenc_list%level(k) = plplenc_old%level(k) - else if (((idnew1 == idold2) .and. (idnew2 == idold1))) then - ! This is an encounter we already know about, but with the order reversed, so save the old information - system%plplenc_list%lvdotr(k) = plplenc_old%lvdotr(k) - system%plplenc_list%status(k) = plplenc_old%status(k) - system%plplenc_list%x1(:,k) = plplenc_old%x2(:,k) - system%plplenc_list%x2(:,k) = plplenc_old%x1(:,k) - system%plplenc_list%v1(:,k) = plplenc_old%v2(:,k) - system%plplenc_list%v2(:,k) = plplenc_old%v1(:,k) - system%plplenc_list%t(k) = plplenc_old%t(k) - system%plplenc_list%level(k) = plplenc_old%level(k) - end if - system%plplenc_list%index1(k) = findloc(pl%id(1:npl), system%plplenc_list%id1(k), dim=1) - system%plplenc_list%index2(k) = findloc(pl%id(1:npl), system%plplenc_list%id2(k), dim=1) - end do - if (allocated(lmask)) deallocate(lmask) - allocate(lmask(nencmin)) - nenc_old = nencmin - if (any(system%plplenc_list%index1(1:nencmin) == 0) .or. any(system%plplenc_list%index2(1:nencmin) == 0)) then - lmask(:) = system%plplenc_list%index1(1:nencmin) /= 0 .and. system%plplenc_list%index2(1:nencmin) /= 0 - else - return - end if - nencmin = count(lmask(:)) - system%plplenc_list%nenc = nencmin - if (nencmin > 0) then - system%plplenc_list%index1(1:nencmin) = pack(system%plplenc_list%index1(1:nenc_old), lmask(1:nenc_old)) - system%plplenc_list%index2(1:nencmin) = pack(system%plplenc_list%index2(1:nenc_old), lmask(1:nenc_old)) - system%plplenc_list%id1(1:nencmin) = pack(system%plplenc_list%id1(1:nenc_old), lmask(1:nenc_old)) - system%plplenc_list%id2(1:nencmin) = pack(system%plplenc_list%id2(1:nenc_old), lmask(1:nenc_old)) - system%plplenc_list%lvdotr(1:nencmin) = pack(system%plplenc_list%lvdotr(1:nenc_old), lmask(1:nenc_old)) - system%plplenc_list%status(1:nencmin) = pack(system%plplenc_list%status(1:nenc_old), lmask(1:nenc_old)) - system%plplenc_list%t(1:nencmin) = pack(system%plplenc_list%t(1:nenc_old), lmask(1:nenc_old)) - system%plplenc_list%level(1:nencmin) = pack(system%plplenc_list%level(1:nenc_old), lmask(1:nenc_old)) - do i = 1, NDIM - system%plplenc_list%x1(i, 1:nencmin) = pack(system%plplenc_list%x1(i, 1:nenc_old), lmask(1:nenc_old)) - system%plplenc_list%x2(i, 1:nencmin) = pack(system%plplenc_list%x2(i, 1:nenc_old), lmask(1:nenc_old)) - system%plplenc_list%v1(i, 1:nencmin) = pack(system%plplenc_list%v1(i, 1:nenc_old), lmask(1:nenc_old)) - system%plplenc_list%v2(i, 1:nencmin) = pack(system%plplenc_list%v2(i, 1:nenc_old), lmask(1:nenc_old)) - end do - end if - end if + pl%renc(1:npl) = pl%rhill(1:npl) * RHSCALE * rshell_irec end associate return - end subroutine symba_util_rearray_pl - - - module subroutine symba_util_reset_kinship(self, idx) - !! author: David A. Minton - !! - !! Resets the kinship status of bodies. - !! - implicit none - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - integer(I4B), dimension(:), intent(in) :: idx !! Index array of bodies to reset - ! Internals - integer(I4B) :: i, j - - self%kin(idx(:))%parent = idx(:) - self%kin(idx(:))%nchild = 0 - do j = 1, size(idx(:)) - i = idx(j) - if (allocated(self%kin(i)%child)) deallocate(self%kin(i)%child) - end do - - return - end subroutine symba_util_reset_kinship - + end subroutine symba_util_set_renc - module subroutine symba_util_resize_arr_kin(arr, nnew) + module subroutine symba_util_setup_initialize_system(self, param) !! author: David A. Minton !! - !! Resizes an array component of type character string. Array will only be resized if has previously been allocated. Passing nnew = 0 will deallocate. + !! Initialize an SyMBA nbody system from files and sets up the planetocentric structures. + !! This subroutine will also sort the massive bodies in descending order by mass + !! implicit none ! Arguments - type(symba_kinship), dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size - ! Internals - type(symba_kinship), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated - integer(I4B) :: nold !! Old size - - if (nnew < 0) return - - if (nnew == 0) then - if (allocated(arr)) deallocate(arr) - return - end if - - if (allocated(arr)) then - nold = size(arr) - else - nold = 0 - end if - - allocate(tmp(nnew)) - if (nnew > nold) then - tmp(1:nold) = arr(1:nold) - else - tmp(1:nnew) = arr(1:nnew) - end if - call move_alloc(tmp, arr) + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody_system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + + ! Call parent method + associate(nbody_system => self) + call helio_util_setup_initialize_system(nbody_system, 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) + end associate return - end subroutine symba_util_resize_arr_kin + end subroutine symba_util_setup_initialize_system - module subroutine symba_util_resize_merger(self, nnew) + module subroutine symba_util_setup_pl(self, n, param) !! author: David A. Minton !! - !! Checks the current size of a SyMBA merger list against the requested size and resizes it if it is too small. - implicit none - ! Arguments - class(symba_merger), intent(inout) :: self !! SyMBA massive body object - integer(I4B), intent(in) :: nnew !! New size neded - - call util_resize(self%ncomp, nnew) - - call symba_util_resize_pl(self, nnew) - - return - end subroutine symba_util_resize_merger - - - module subroutine symba_util_resize_pl(self, nnew) - !! author: David A. Minton + !! Allocate SyMBA test particle structure !! - !! Checks the current size of a SyMBA massive body object against the requested size and resizes it if it is too small. + !! 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) :: nnew !! New size neded + 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 + ! Internals + integer(I4B) :: i - call util_resize(self%lcollision, nnew) - call util_resize(self%lencounter, nnew) - call util_resize(self%lmtiny, nnew) - call util_resize(self%nplenc, nnew) - call util_resize(self%ntpenc, nnew) - call util_resize(self%levelg, nnew) - call util_resize(self%levelm, nnew) - call util_resize(self%isperi, nnew) - call util_resize(self%peri, nnew) - call util_resize(self%atp, nnew) - call util_resize(self%kin, nnew) + !> Call allocation method for parent class. + call self%helio_pl%setup(n, param) + if (n == 0) return - call util_resize_pl(self, nnew) + allocate(self%levelg(n)) + allocate(self%levelm(n)) + self%levelg(:) = -1 + self%levelm(:) = -1 return - end subroutine symba_util_resize_pl + end subroutine symba_util_setup_pl - module subroutine symba_util_resize_tp(self, nnew) - !! author: David A. Minton - !! - !! 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 - - call util_resize(self%nplenc, nnew) - call util_resize(self%levelg, nnew) - call util_resize(self%levelm, nnew) - - call util_resize_tp(self, nnew) - - return - end subroutine symba_util_resize_tp - - - module subroutine symba_util_set_renc(self, scale) + module subroutine symba_util_setup_tp(self, n, param) !! author: David A. Minton !! - !! Sets the critical radius for encounter given an input recursion depth + !! Allocate WHM test particle structure !! + !! Equivalent in functionality to David E. Kaufmann's Swifter routine whm_util_setup.f90 implicit none ! Arguments - 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 + 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 - associate(pl => self, npl => self%nbody) - rshell_irec = 1._DP - do i = 1, scale - rshell_irec = rshell_irec * RSHELL - end do - pl%renc(1:npl) = pl%rhill(1:npl) * RHSCALE * rshell_irec - end associate + !> Call allocation method for parent class. + call self%helio_tp%setup(n, param) + if (n == 0) return + + allocate(self%levelg(n)) + allocate(self%levelm(n)) + self%levelg(:) = -1 + self%levelm(:) = -1 + return - end subroutine symba_util_set_renc + end subroutine symba_util_setup_tp module subroutine symba_util_sort_pl(self, sortby, ascending) @@ -946,22 +357,13 @@ module subroutine symba_util_sort_pl(self, sortby, ascending) associate(pl => self, npl => self%nbody) select case(sortby) - case("nplenc") - call util_sort(direction * pl%nplenc(1:npl), ind) - case("ntpenc") - call util_sort(direction * pl%ntpenc(1:npl), ind) case("levelg") - call util_sort(direction * pl%levelg(1:npl), ind) + call swiftest_util_sort(direction * pl%levelg(1:npl), ind) case("levelm") - call util_sort(direction * pl%levelm(1:npl), ind) - case("peri") - call util_sort(direction * pl%peri(1:npl), ind) - case("atp") - call util_sort(direction * pl%atp(1:npl), ind) - case("lcollision", "lencounter", "lmtiny", "nplm", "nplplm", "kin", "info") - write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' + call swiftest_util_sort(direction * pl%levelm(1:npl), ind) + case default ! Look for components in the parent class - call util_sort_pl(pl, sortby, ascending) + call swiftest_util_sort_pl(pl, sortby, ascending) return end select @@ -997,13 +399,13 @@ module subroutine symba_util_sort_tp(self, sortby, ascending) associate(tp => self, ntp => self%nbody) select case(sortby) case("nplenc") - call util_sort(direction * tp%nplenc(1:ntp), ind) + call swiftest_util_sort(direction * tp%nplenc(1:ntp), ind) case("levelg") - call util_sort(direction * tp%levelg(1:ntp), ind) + call swiftest_util_sort(direction * tp%levelg(1:ntp), ind) case("levelm") - call util_sort(direction * tp%levelm(1:ntp), ind) + call swiftest_util_sort(direction * tp%levelm(1:ntp), ind) case default ! Look for components in the parent class - call util_sort_tp(tp, sortby, ascending) + call swiftest_util_sort_tp(tp, sortby, ascending) return end select @@ -1014,35 +416,6 @@ module subroutine symba_util_sort_tp(self, sortby, ascending) end subroutine symba_util_sort_tp - - module subroutine symba_util_sort_rearrange_arr_kin(arr, ind, n) - !! author: David A. Minton - !! - !! Rearrange a single array of particle kinship type in-place from an index list. - implicit none - ! Arguments - type(symba_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 - ! Internals - type(symba_kinship), dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation - integer(I4B) :: i,j - - if (.not. allocated(arr) .or. n <= 0) return - allocate(tmp, source=arr) - tmp(1:n) = arr(ind(1:n)) - - do i = 1, n - do j = 1, tmp(i)%nchild - tmp(i)%child(j) = ind(tmp(i)%child(j)) - end do - end do - - call move_alloc(tmp, arr) - return - end subroutine symba_util_sort_rearrange_arr_kin - - module subroutine symba_util_sort_rearrange_pl(self, ind) !! author: David A. Minton !! @@ -1054,19 +427,9 @@ module subroutine symba_util_sort_rearrange_pl(self, ind) 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%lcollision, ind, npl) - call util_sort_rearrange(pl%lencounter, ind, npl) - call util_sort_rearrange(pl%lmtiny, ind, npl) - call util_sort_rearrange(pl%nplenc, ind, npl) - call util_sort_rearrange(pl%ntpenc, ind, npl) - call util_sort_rearrange(pl%levelg, ind, npl) - call util_sort_rearrange(pl%levelm, ind, npl) - call util_sort_rearrange(pl%isperi, ind, npl) - call util_sort_rearrange(pl%peri, ind, npl) - call util_sort_rearrange(pl%atp, ind, npl) - call util_sort_rearrange(pl%kin, ind, npl) - - call util_sort_rearrange_pl(pl,ind) + call swiftest_util_sort_rearrange(pl%levelg, ind, npl) + call swiftest_util_sort_rearrange(pl%levelm, ind, npl) + call swiftest_util_sort_rearrange_pl(pl,ind) end associate return @@ -1084,59 +447,17 @@ module subroutine symba_util_sort_rearrange_tp(self, ind) 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) - call util_sort_rearrange(tp%levelg, ind, ntp) - call util_sort_rearrange(tp%levelm, ind, ntp) + call swiftest_util_sort_rearrange(tp%nplenc, ind, ntp) + call swiftest_util_sort_rearrange(tp%levelg, ind, ntp) + call swiftest_util_sort_rearrange(tp%levelm, ind, ntp) - call util_sort_rearrange_tp(tp,ind) + call swiftest_util_sort_rearrange_tp(tp,ind) end associate return end subroutine symba_util_sort_rearrange_tp - module subroutine symba_util_spill_arr_kin(keeps, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Performs a spill operation on a single array of particle kinships - !! This is the inverse of a spill operation - implicit none - ! Arguments - type(symba_kinship), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - type(symba_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 - ! Internals - integer(I4B) :: nspill, nkeep, nlist - type(symba_kinship), dimension(:), allocatable :: tmp - - nkeep = count(.not.lspill_list(:)) - nspill = count(lspill_list(:)) - nlist = size(lspill_list(:)) - - if (.not.allocated(keeps) .or. nspill == 0) return - if (.not.allocated(discards)) then - allocate(discards(nspill)) - else if (size(discards) /= nspill) then - deallocate(discards) - allocate(discards(nspill)) - end if - - discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) - if (ldestructive) then - if (nkeep > 0) then - allocate(tmp(nkeep)) - tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) - call move_alloc(tmp, keeps) - else - deallocate(keeps) - end if - end if - - return - end subroutine symba_util_spill_arr_kin - - module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive) !! author: David A. Minton !! @@ -1154,19 +475,10 @@ module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive) associate(keeps => self) select type(discards) class is (symba_pl) - call util_spill(keeps%lcollision, discards%lcollision, lspill_list, ldestructive) - call util_spill(keeps%lencounter, discards%lencounter, lspill_list, ldestructive) - call util_spill(keeps%lmtiny, discards%lmtiny, lspill_list, ldestructive) - call util_spill(keeps%nplenc, discards%nplenc, lspill_list, ldestructive) - call util_spill(keeps%ntpenc, discards%ntpenc, lspill_list, ldestructive) - call util_spill(keeps%levelg, discards%levelg, lspill_list, ldestructive) - call util_spill(keeps%levelm, discards%levelm, lspill_list, ldestructive) - call util_spill(keeps%isperi, discards%isperi, lspill_list, ldestructive) - call util_spill(keeps%peri, discards%peri, lspill_list, ldestructive) - call util_spill(keeps%atp, discards%atp, lspill_list, ldestructive) - call util_spill(keeps%kin, discards%kin, lspill_list, ldestructive) - - call util_spill_pl(keeps, discards, lspill_list, ldestructive) + call swiftest_util_spill(keeps%levelg, discards%levelg, lspill_list, ldestructive) + call swiftest_util_spill(keeps%levelm, discards%levelm, lspill_list, ldestructive) + + call swiftest_util_spill_pl(keeps, discards, lspill_list, ldestructive) class default write(*,*) "Invalid object passed to the spill method. Source must be of class symba_pl or its descendents!" call util_exit(FAILURE) @@ -1177,33 +489,6 @@ module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive) end subroutine symba_util_spill_pl - module subroutine symba_util_spill_encounter_list(self, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Move spilled (discarded) SyMBA encounter structure from active list to discard list - !! Note: Because the symba_plplenc currently does not contain any additional variable components, this method can recieve it as an input as well. - implicit none - ! Arguments - class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list - class(encounter_list), 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 - - associate(keeps => self) - select type(discards) - class is (symba_encounter) - call util_spill(keeps%level, discards%level, lspill_list, ldestructive) - call encounter_util_spill_list(keeps, discards, lspill_list, ldestructive) - class default - write(*,*) "Invalid object passed to the spill method. Source must be of class symba_encounter or its descendents!" - call util_exit(FAILURE) - end select - end associate - - return - end subroutine symba_util_spill_encounter_list - - module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) !! author: David A. Minton !! @@ -1221,11 +506,11 @@ module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) 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) + call swiftest_util_spill(keeps%nplenc, discards%nplenc, lspill_list, ldestructive) + call swiftest_util_spill(keeps%levelg, discards%levelg, lspill_list, ldestructive) + call swiftest_util_spill(keeps%levelm, discards%levelm, lspill_list, ldestructive) - call util_spill_tp(keeps, discards, lspill_list, ldestructive) + call swiftest_util_spill_tp(keeps, discards, lspill_list, ldestructive) class default write(*,*) "Invalid object passed to the spill method. Source must be of class symba_tp or its descendents!" call util_exit(FAILURE) @@ -1235,4 +520,6 @@ module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) return end subroutine symba_util_spill_tp + + end submodule s_symba_util diff --git a/src/tides/tides_getacch_pl.f90 b/src/tides/tides_getacch_pl.f90 index 4feb76221..f3da3cfc5 100644 --- a/src/tides/tides_getacch_pl.f90 +++ b/src/tides/tides_getacch_pl.f90 @@ -1,8 +1,8 @@ -submodule(swiftest_classes) s_tides_kick_getacch +submodule(tides) s_tides_kick_getacch use swiftest contains - module subroutine tides_kick_getacch_pl(self, system) + module subroutine tides_kick_getacch_pl(self, nbody_system) !! author: Jennifer L.L. Pouplin, Carlisle A. wishard, and David A. Minton !! !! Calculated tidal torques from central body to any planet and from any planet to central body @@ -17,47 +17,53 @@ module subroutine tides_kick_getacch_pl(self, system) !! Applications to Kepler-62. A&A 583, A116. https://doi.org/10.1051/0004-6361/201525909 implicit none ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_object), intent(inout) :: self !! Swiftest massive body object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object ! Internals integer(I4B) :: i real(DP) :: rmag, vmag real(DP), dimension(NDIM) :: r_unit, v_unit, h_unit, theta_unit, theta_dot, F_T real(DP) :: Ftr, Ptopl, Ptocb, r5cbterm, r5plterm - associate(pl => self, npl => self%nbody, cb => system%cb) - pl%atide(:,:) = 0.0_DP - cb%atide(:) = 0.0_DP - do i = 1, npl - rmag = norm2(pl%xh(:,i)) - vmag = norm2(pl%vh(:,i)) - r_unit(:) = pl%xh(:,i) / rmag - v_unit(:) = pl%vh(:,i) / vmag - h_unit(:) = r_unit(:) .cross. v_unit(:) - theta_unit(:) = h_unit(:) .cross. r_unit(:) - theta_dot = dot_product(pl%vh(:,i), theta_unit(:)) + select type(pl => self) + class is (swiftest_pl) + select type(nbody_system) + class is (swiftest_nbody_system) + associate(npl => pl%nbody, cb => nbody_system%cb) + pl%atide(:,:) = 0.0_DP + cb%atide(:) = 0.0_DP + do i = 1, npl + rmag = norm2(pl%rh(:,i)) + vmag = norm2(pl%vh(:,i)) + r_unit(:) = pl%rh(:,i) / rmag + v_unit(:) = pl%vh(:,i) / vmag + h_unit(:) = r_unit(:) .cross. v_unit(:) + theta_unit(:) = h_unit(:) .cross. r_unit(:) + theta_dot = dot_product(pl%vh(:,i), theta_unit(:)) - ! First calculate the tangential component of the force vector (eq. 5 & 6 of Bolmont et al. 2015) - ! The radial component is already computed in the obl_acc methods - r5cbterm = pl%Gmass(i)**2 * cb%k2 * cb%radius**5 - r5plterm = cb%Gmass**2 * pl%k2(i) * pl%radius(i)**5 + ! First calculate the tangential component of the force vector (eq. 5 & 6 of Bolmont et al. 2015) + ! The radial component is already computed in the obl_acc methods + r5cbterm = pl%Gmass(i)**2 * cb%k2 * cb%radius**5 + r5plterm = cb%Gmass**2 * pl%k2(i) * pl%radius(i)**5 - Ptopl = 3 * r5plterm * pl%tlag(i) / rmag**7 - Ptocb = 3 * r5cbterm * cb%tlag / rmag**7 + Ptopl = 3 * r5plterm * pl%tlag(i) / rmag**7 + Ptocb = 3 * r5cbterm * cb%tlag / rmag**7 - Ftr = -3 / rmag**7 * (r5cbterm + r5plterm) - 3 * vmag / rmag * (Ptocb + Ptopl) + Ftr = -3 / rmag**7 * (r5cbterm + r5plterm) - 3 * vmag / rmag * (Ptocb + Ptopl) - F_T(:) = (Ftr + (Ptocb + Ptopl) * dot_product(v_unit, r_unit) / rmag) * r_unit(:) & - + Ptopl * ((pl%rot(:,i) - theta_dot(:)) .cross. r_unit(:)) & - + Ptocb * ((cb%rot(:) - theta_dot(:)) .cross. r_unit(:)) - cb%atide(:) = cb%atide(:) + F_T(:) / cb%Gmass - pl%atide(:,i) = F_T(:) / pl%Gmass(i) - end do + F_T(:) = (Ftr + (Ptocb + Ptopl) * dot_product(v_unit, r_unit) / rmag) * r_unit(:) & + + Ptopl * ((pl%rot(:,i) - theta_dot(:)) .cross. r_unit(:)) & + + Ptocb * ((cb%rot(:) - theta_dot(:)) .cross. r_unit(:)) + cb%atide(:) = cb%atide(:) + F_T(:) / cb%Gmass + pl%atide(:,i) = F_T(:) / pl%Gmass(i) + end do - do i = 1, npl - pl%ah(:,i) = pl%ah(:,i) + pl%atide(:,i) + cb%atide(:) - end do - end associate + do i = 1, npl + pl%ah(:,i) = pl%ah(:,i) + pl%atide(:,i) + cb%atide(:) + end do + end associate + end select + end select return end subroutine tides_kick_getacch_pl diff --git a/src/tides/tides_module.f90 b/src/tides/tides_module.f90 new file mode 100644 index 000000000..828575f76 --- /dev/null +++ b/src/tides/tides_module.f90 @@ -0,0 +1,92 @@ +!! 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. + +module tides + !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Definition of classes and methods used to determine close encounters + use base + use lambda_function + implicit none + public + + + type, extends(lambda_obj_tvar) :: tides_derivs_func + !! Base class for an lambda function object. This object takes no additional arguments other than the dependent variable x, an array of real numbers + procedure(tidederiv), pointer, nopass :: lambdaptr_tides_deriv + real(DP), dimension(:,:), allocatable :: rbeg + real(DP), dimension(:,:), allocatable :: rend + real(DP) :: dt + contains + generic :: init => tides_derivs_init + procedure :: evalt => tides_derivs_eval + procedure, nopass :: tides_derivs_init + end type + interface lambda_obj + module procedure tides_derivs_init + end interface + + abstract interface + function tidederiv(x, t, dt, rbeg, rend) result(y) + ! Template for a 0 argument function + import DP, base_nbody_system + real(DP), dimension(:), intent(in) :: x + real(DP), intent(in) :: t + real(DP), intent(in) :: dt + real(DP), dimension(:,:), intent(in) :: rbeg + real(DP), dimension(:,:), intent(in) :: rend + real(DP), dimension(:), allocatable :: y + end function + end interface + + + interface + module subroutine tides_kick_getacch_pl(self, nbody_system) + implicit none + class(base_object), intent(inout) :: self !! Swiftest massive body object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + end subroutine tides_kick_getacch_pl + + module function tides_derivs_init(lambda, dt, rbeg, rend) result(f) + implicit none + procedure(tidederiv) :: lambda + real(DP), intent(in) :: dt + real(DP), dimension(:,:), intent(in) :: rbeg + real(DP), dimension(:,:), intent(in) :: rend + type(tides_derivs_func) :: f + end function tides_derivs_init + + module function tides_derivs_eval(self, x, t) result(y) + class(tides_derivs_func), intent(inout) :: self + real(DP), dimension(:), intent(in) :: x + real(DP), intent(in) :: t + real(DP), dimension(:), allocatable :: y + end function tides_derivs_eval + + module function tides_spin_derivs(rot_pl_cb, t, dt, rbeg, rend) result(drot) !! Need to add more arguments so we can pull in mass, radius, Ip, J2, etc... + real(DP), dimension(:,:), intent(in) :: rot_pl_cb !! Array of rotations. The last element is the central body, and all others are massive bodies + real(DP), intent(in) :: t !! Current time, which is used to interpolate the massive body positions + real(DP), intent(in) :: dt !! Total step size + real(DP), dimension(:,:), intent(in) :: rbeg + real(DP), dimension(:,:), intent(in) :: rend + real(DP), dimension(:,:), allocatable :: drot + end function tides_spin_derivs + + module subroutine tides_step_spin_system(self, param, t, dt) + implicit none + class(base_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Simulation time + real(DP), intent(in) :: dt !! Current stepsize + end subroutine tides_step_spin_system + + end interface + + +end module \ No newline at end of file diff --git a/src/tides/tides_spin_step.f90 b/src/tides/tides_spin_step.f90 index 576aff8d7..40a8f1659 100644 --- a/src/tides/tides_spin_step.f90 +++ b/src/tides/tides_spin_step.f90 @@ -1,43 +1,16 @@ -submodule(swiftest_classes) s_tides_step_spin +submodule(tides) s_tides_step_spin use swiftest - type, extends(lambda_obj_tvar) :: tides_derivs_func - !! Base class for an lambda function object. This object takes no additional arguments other than the dependent variable x, an array of real numbers - procedure(tidederiv), pointer, nopass :: lambdaptr_tides_deriv - real(DP), dimension(:,:), allocatable :: xbeg - real(DP), dimension(:,:), allocatable :: xend - real(DP) :: dt - contains - generic :: init => tides_derivs_init - procedure :: evalt => tides_derivs_eval - procedure, nopass :: tides_derivs_init - end type - interface lambda_obj - module procedure tides_derivs_init - end interface - abstract interface - function tidederiv(x, t, dt, xbeg, xend) result(y) - ! Template for a 0 argument function - import DP, swiftest_nbody_system - real(DP), dimension(:), intent(in) :: x - real(DP), intent(in) :: t - real(DP), intent(in) :: dt - real(DP), dimension(:,:), intent(in) :: xbeg - real(DP), dimension(:,:), intent(in) :: xend - real(DP), dimension(:), allocatable :: y - end function - end interface - contains module subroutine tides_step_spin_system(self, param, t, dt) !! author: Jennifer L.L. Pouplin and David A. Minton !! - !! Integrates the spin equations for central and massive bodies of the system subjected to tides. + !! Integrates the spin equations for central and massive bodies of the nbody_system subjected to tides. implicit none ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + class(base_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Simulation time real(DP), intent(in) :: dt !! Current stepsize ! Internals @@ -46,22 +19,25 @@ module subroutine tides_step_spin_system(self, param, t, dt) real(DP), parameter :: tol=1e-6_DP !! Just a guess at the moment real(DP) :: subdt - associate(pl => self%pl, npl => self%pl%nbody, cb => self%cb) - allocate(rot0(NDIM*(npl+1))) - rot0 = [pack(pl%rot(:,1:npl),.true.), pack(cb%rot(:),.true.)] - ! Use this space call the ode_solver, passing tides_spin_derivs as the function: - subdt = dt / 20._DP - !rot1(:) = util_solve_rkf45(lambda_obj(tides_spin_derivs, subdt, pl%xbeg, pl%xend), rot0, dt, subdt tol) - ! Recover with unpack - !pl%rot(:,1:npl) = unpack(rot1... - !cb%rot(:) = unpack(rot1... - end associate + select type(self) + class is (swiftest_nbody_system) + associate(pl => self%pl, npl => self%pl%nbody, cb => self%cb) + allocate(rot0(NDIM*(npl+1))) + ! rot0 = [pack(pl%rot(:,1:npl),.true.), pack(cb%rot(:),.true.)] + ! Use this space call the ode_solver, passing tides_spin_derivs as the function: + ! subdt = dt / 20._DP + ! rot1(:) = swiftest_util_solve_rkf45(lambda_obj(tides_spin_derivs, subdt, pl%rbeg, pl%rend), rot0, dt, subdt,tol) + ! ! Recover with unpack + ! pl%rot(:,1:npl) = unpack(rot1... + ! cb%rot(:) = unpack(rot1... + end associate + end select return end subroutine tides_step_spin_system - function tides_spin_derivs(rot_pl_cb, t, dt, xbeg, xend) result(drot) !! Need to add more arguments so we can pull in mass, radius, Ip, J2, etc... + module function tides_spin_derivs(rot_pl_cb, t, dt, rbeg, rend) result(drot) !! Need to add more arguments so we can pull in mass, radius, Ip, J2, etc... !! author: Jennifer L.L. Pouplin and David A. Minton !! !! function used to calculate the derivatives that are fed to the ODE solver @@ -70,8 +46,8 @@ function tides_spin_derivs(rot_pl_cb, t, dt, xbeg, xend) result(drot) !! Need to real(DP), dimension(:,:), intent(in) :: rot_pl_cb !! Array of rotations. The last element is the central body, and all others are massive bodies real(DP), intent(in) :: t !! Current time, which is used to interpolate the massive body positions real(DP), intent(in) :: dt !! Total step size - real(DP), dimension(:,:), intent(in) :: xbeg - real(DP), dimension(:,:), intent(in) :: xend + real(DP), dimension(:,:), intent(in) :: rbeg + real(DP), dimension(:,:), intent(in) :: rend ! Internals real(DP), dimension(:,:), allocatable :: drot real(DP), dimension(:), allocatable :: flatrot @@ -85,7 +61,7 @@ function tides_spin_derivs(rot_pl_cb, t, dt, xbeg, xend) result(drot) !! Need to allocate(drot, mold=rot_pl_cb) drot(:,:) = 0.0_DP do i = 1,n-1 - xinterp(:) = xbeg(:,i) + t / dt * (xend(:,i) - xbeg(:,i)) + xinterp(:) = rbeg(:,i) + t / dt * (rend(:,i) - rbeg(:,i)) ! Calculate Ncb and Npl as a function of xinterp !drot(:,i) = -Mcb / (Mcb + Mpl(i)) * (N_Tpl + N_Rpl) !drot(:,n) = drot(:,n) - Mcb / (Mcb + Mpl(i) * (N_Tcb + N_Rcb) @@ -95,7 +71,7 @@ function tides_spin_derivs(rot_pl_cb, t, dt, xbeg, xend) result(drot) !! Need to return end function tides_spin_derivs - function tides_derivs_eval(self, x, t) result(y) + module function tides_derivs_eval(self, x, t) result(y) implicit none ! Arguments class(tides_derivs_func), intent(inout) :: self @@ -104,7 +80,7 @@ function tides_derivs_eval(self, x, t) result(y) ! Result real(DP), dimension(:), allocatable :: y if (associated(self%lambdaptr_tides_deriv)) then - y = self%lambdaptr_tides_deriv(x, t, self%dt, self%xbeg, self%xend) + y = self%lambdaptr_tides_deriv(x, t, self%dt, self%rbeg, self%rend) else error stop "Lambda function was not initialized" end if @@ -112,19 +88,19 @@ function tides_derivs_eval(self, x, t) result(y) return end function tides_derivs_eval - function tides_derivs_init(lambda, dt, xbeg, xend) result(f) + module function tides_derivs_init(lambda, dt, rbeg, rend) result(f) implicit none ! Arguments procedure(tidederiv) :: lambda real(DP), intent(in) :: dt - real(DP), dimension(:,:), intent(in) :: xbeg - real(DP), dimension(:,:), intent(in) :: xend + real(DP), dimension(:,:), intent(in) :: rbeg + real(DP), dimension(:,:), intent(in) :: rend ! Result type(tides_derivs_func) :: f f%lambdaptr_tides_deriv => lambda f%dt = dt - allocate(f%xbeg, source = xbeg) - allocate(f%xend, source = xend) + allocate(f%rbeg, source = rbeg) + allocate(f%rend, source = rend) return end function tides_derivs_init diff --git a/src/util/util_append.f90 b/src/util/util_append.f90 deleted file mode 100644 index d59704374..000000000 --- a/src/util/util_append.f90 +++ /dev/null @@ -1,304 +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. - -submodule (swiftest_classes) s_util_append - use swiftest -contains - - module subroutine util_append_arr_char_string(arr, source, nold, nsrc, 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. - 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) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - ! Internals - integer(I4B) :: nnew - - if (.not. allocated(source)) return - - nnew = count(lsource_mask(1:nsrc)) - if (.not.allocated(arr)) then - allocate(arr(nold+nnew)) - else - call util_resize(arr, nold + nnew) - end if - - arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) - - return - end subroutine util_append_arr_char_string - - - module subroutine util_append_arr_DP(arr, source, nold, nsrc, 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. - 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) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - ! Internals - integer(I4B) :: nnew - - if (.not. allocated(source)) return - - nnew = count(lsource_mask(1:nsrc)) - if (.not.allocated(arr)) then - allocate(arr(nold+nnew)) - else - call util_resize(arr, nold + nnew) - end if - - arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) - - return - end subroutine util_append_arr_DP - - - module subroutine util_append_arr_DPvec(arr, source, nold, nsrc, 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. - 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) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - ! Internals - integer(I4B) :: nnew - - if (.not. allocated(source)) return - - nnew = count(lsource_mask(1:nsrc)) - if (.not.allocated(arr)) then - allocate(arr(NDIM,nold+nnew)) - else - call util_resize(arr, nold + nnew) - end if - - arr(1, nold + 1:nold + nnew) = pack(source(1,1:nsrc), lsource_mask(1:nsrc)) - arr(2, nold + 1:nold + nnew) = pack(source(2,1:nsrc), lsource_mask(1:nsrc)) - arr(3, nold + 1:nold + nnew) = pack(source(3,1:nsrc), lsource_mask(1:nsrc)) - - return - end subroutine util_append_arr_DPvec - - - module subroutine util_append_arr_I4B(arr, source, nold, nsrc, 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. - 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) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - ! Internals - integer(I4B) :: nnew - - if (.not. allocated(source)) return - - nnew = count(lsource_mask(1:nsrc)) - if (.not.allocated(arr)) then - allocate(arr(nold+nnew)) - else - call util_resize(arr, nold + nnew) - end if - - arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) - - return - end subroutine util_append_arr_I4B - - - module subroutine util_append_arr_info(arr, source, nold, nsrc, lsource_mask) - !! author: David A. Minton - !! - !! Append a single array of particle information type onto another. If the destination array is not allocated, or is not big enough, this will allocate space for it. - implicit none - ! Arguments - 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) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - ! Internals - integer(I4B) :: nnew, i - integer(I4B), dimension(:), allocatable :: idx - - if (.not. allocated(source)) return - - nnew = count(lsource_mask(1:nsrc)) - if (.not.allocated(arr)) then - allocate(arr(nold+nnew)) - else - call util_resize(arr, nold + nnew) - end if - - allocate(idx(nnew)) - - idx = pack([(i, i = 1, nsrc)], lsource_mask(1:nsrc)) - - call util_copy_particle_info_arr(source(1:nsrc), arr(nold+1:nold+nnew), idx) - - return - end subroutine util_append_arr_info - - - module subroutine util_append_arr_logical(arr, source, nold, nsrc, 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. - implicit none - ! Arguments - logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array - logical, dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - ! Internals - integer(I4B) :: nnew - - if (.not. allocated(source)) return - - nnew = count(lsource_mask(1:nsrc)) - if (.not.allocated(arr)) then - allocate(arr(nold+nnew)) - else - call util_resize(arr, nold + nnew) - end if - - arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) - - return - end subroutine util_append_arr_logical - - - module subroutine util_append_body(self, source, lsource_mask) - !! author: David A. Minton - !! - !! Append components from one Swiftest body object to another. - !! This method will automatically resize the destination body if it is too small - implicit none - ! Arguments - 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 - ! Internals - integer(I4B) :: nold, nsrc, nnew - - nold = self%nbody - nsrc = source%nbody - nnew = count(lsource_mask(1:nsrc)) - - call util_append(self%info, source%info, nold, nsrc, lsource_mask) - call util_append(self%id, source%id, nold, nsrc, lsource_mask) - call util_append(self%status, source%status, nold, nsrc, lsource_mask) - call util_append(self%ldiscard, source%ldiscard, nold, nsrc, lsource_mask) - call util_append(self%lmask, source%lmask, nold, nsrc, lsource_mask) - call util_append(self%mu, source%mu, nold, nsrc, lsource_mask) - call util_append(self%xh, source%xh, nold, nsrc, lsource_mask) - call util_append(self%vh, source%vh, nold, nsrc, lsource_mask) - call util_append(self%xb, source%xb, nold, nsrc, lsource_mask) - call util_append(self%vb, source%vb, nold, nsrc, lsource_mask) - call util_append(self%ah, source%ah, nold, nsrc, lsource_mask) - call util_append(self%aobl, source%aobl, nold, nsrc, lsource_mask) - call util_append(self%atide, source%atide, nold, nsrc, lsource_mask) - call util_append(self%agr, source%agr, nold, nsrc, lsource_mask) - call util_append(self%ir3h, source%ir3h, nold, nsrc, lsource_mask) - call util_append(self%a, source%a, nold, nsrc, lsource_mask) - call util_append(self%e, source%e, nold, nsrc, lsource_mask) - call util_append(self%inc, source%inc, nold, nsrc, lsource_mask) - call util_append(self%capom, source%capom, nold, nsrc, lsource_mask) - call util_append(self%omega, source%omega, nold, nsrc, lsource_mask) - call util_append(self%capm, source%capm, nold, nsrc, lsource_mask) - - self%nbody = nold + nnew - - return - end subroutine util_append_body - - - module subroutine util_append_pl(self, source, lsource_mask) - !! author: David A. Minton - !! - !! Append components from one Swiftest body object to another. - !! This method will automatically resize the destination body if it is too small - implicit none - ! Arguments - 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 - - select type(source) - class is (swiftest_pl) - associate(nold => self%nbody, nsrc => source%nbody) - call util_append(self%mass, source%mass, nold, nsrc, lsource_mask) - call util_append(self%Gmass, source%Gmass, nold, nsrc, lsource_mask) - call util_append(self%rhill, source%rhill, nold, nsrc, lsource_mask) - call util_append(self%renc, source%renc, nold, nsrc, lsource_mask) - call util_append(self%radius, source%radius, nold, nsrc, lsource_mask) - call util_append(self%xbeg, source%xbeg, nold, nsrc, lsource_mask) - call util_append(self%xend, source%xend, nold, nsrc, lsource_mask) - call util_append(self%vbeg, source%vbeg, nold, nsrc, lsource_mask) - call util_append(self%density, source%density, nold, nsrc, lsource_mask) - call util_append(self%Ip, source%Ip, nold, nsrc, lsource_mask) - call util_append(self%rot, source%rot, nold, nsrc, lsource_mask) - call util_append(self%k2, source%k2, nold, nsrc, lsource_mask) - call util_append(self%Q, source%Q, nold, nsrc, lsource_mask) - call util_append(self%tlag, source%tlag, nold, nsrc, lsource_mask) - - if (allocated(self%k_plpl)) deallocate(self%k_plpl) - - call util_append_body(self, source, lsource_mask) - end associate - class default - write(*,*) "Invalid object passed to the append method. Source must be of class swiftest_pl or its descendents" - call util_exit(FAILURE) - end select - - return - end subroutine util_append_pl - - - module subroutine util_append_tp(self, source, lsource_mask) - !! author: David A. Minton - !! - !! Append components from one Swiftest body object to another. - !! This method will automatically resize the destination body if it is too small - implicit none - ! Arguments - 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 - - select type(source) - class is (swiftest_tp) - associate(nold => self%nbody, nsrc => source%nbody) - call util_append(self%isperi, source%isperi, nold, nsrc, lsource_mask) - call util_append(self%peri, source%peri, nold, nsrc, lsource_mask) - call util_append(self%atp, source%atp, nold, nsrc, lsource_mask) - - call util_append_body(self, source, lsource_mask) - end associate - class default - write(*,*) "Invalid object passed to the append method. Source must be of class swiftest_tp or its descendents" - call util_exit(FAILURE) - end select - - return - end subroutine util_append_tp - -end submodule s_util_append \ No newline at end of file diff --git a/src/util/util_coord.f90 b/src/util/util_coord.f90 deleted file mode 100644 index 21b57844d..000000000 --- a/src/util/util_coord.f90 +++ /dev/null @@ -1,309 +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. - -submodule(swiftest_classes) s_util_coord - use swiftest -contains - - module subroutine util_coord_h2b_pl(self, cb) - !! author: David A. Minton - !! - !! Convert massive bodies from heliocentric to barycentric coordinates (position and velocity) - !! - !! Adapted from David E. Kaufmann's Swifter routine coord_h2b.f90 - !! Adapted from Hal Levison's Swift routine coord_h2b.f - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - ! Internals - integer(I4B) :: i - real(DP) :: Gmtot - real(DP), dimension(NDIM) :: xtmp, vtmp - - if (self%nbody == 0) return - associate(pl => self, npl => self%nbody) - Gmtot = cb%Gmass - xtmp(:) = 0.0_DP - vtmp(:) = 0.0_DP - do i = 1, npl - if (pl%status(i) == INACTIVE) cycle - Gmtot = Gmtot + pl%Gmass(i) - xtmp(:) = xtmp(:) + pl%Gmass(i) * pl%xh(:,i) - vtmp(:) = vtmp(:) + pl%Gmass(i) * pl%vh(:,i) - end do - cb%xb(:) = -xtmp(:) / Gmtot - cb%vb(:) = -vtmp(:) / Gmtot - do i = 1, npl - if (pl%status(i) == INACTIVE) cycle - pl%xb(:,i) = pl%xh(:,i) + cb%xb(:) - pl%vb(:,i) = pl%vh(:,i) + cb%vb(:) - end do - end associate - - return - end subroutine util_coord_h2b_pl - - - module subroutine util_coord_h2b_tp(self, cb) - !! author: David A. Minton - !! - !! Convert test particles from heliocentric to barycentric coordinates (position and velocity) - !! - !! Adapted from David E. Kaufmann's Swifter routine coord_h2b_tp.f90 - !! Adapted from Hal Levison's Swift routine coord_h2b_tp.f - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_cb), intent(in) :: cb !! Swiftest central body object - ! Internals - integer(I4B) :: i - - if (self%nbody == 0) return - associate(tp => self, ntp => self%nbody) - do concurrent (i = 1:ntp, tp%status(i) /= INACTIVE) - tp%xb(:, i) = tp%xh(:, i) + cb%xb(:) - tp%vb(:, i) = tp%vh(:, i) + cb%vb(:) - end do - end associate - - return - end subroutine util_coord_h2b_tp - - - module subroutine util_coord_b2h_pl(self, cb) - !! author: David A. Minton - !! - !! Convert massive bodies from barycentric to heliocentric coordinates (position and velocity) - !! - !! Adapted from David E. Kaufmann's Swifter routine coord_b2h.f90 - !! Adapted from Hal Levison's Swift routine coord_b2h.f - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - ! Internals - integer(I4B) :: i - - if (self%nbody == 0) return - - associate(pl => self, npl => self%nbody) - do concurrent (i = 1:npl, pl%status(i) /= INACTIVE) - pl%xh(:, i) = pl%xb(:, i) - cb%xb(:) - pl%vh(:, i) = pl%vb(:, i) - cb%vb(:) - end do - end associate - - return - end subroutine util_coord_b2h_pl - - - module subroutine util_coord_b2h_tp(self, cb) - !! author: David A. Minton - !! - !! Convert test particles from barycentric to heliocentric coordinates (position and velocity) - !! - !! Adapted from David E. Kaufmann's Swifter routine coord_b2h_tp.f90 - !! Adapted from Hal Levison's Swift routine coord_b2h_tp.f - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(in) :: cb !! Swiftest central body object - ! Internals - integer(I4B) :: i - - if (self%nbody == 0) return - - associate(tp => self, ntp => self%nbody) - do concurrent(i = 1:ntp, tp%status(i) /= INACTIVE) - tp%xh(:, i) = tp%xb(:, i) - cb%xb(:) - tp%vh(:, i) = tp%vb(:, i) - cb%vb(:) - end do - end associate - - return - end subroutine util_coord_b2h_tp - - - module subroutine util_coord_vb2vh_pl(self, cb) - !! author: David A. Minton - !! - !! Convert massive bodies from barycentric to heliocentric coordinates (velocity only) - !! - !! Adapted from David E. Kaufmann's Swifter routine coord_vb2vh.f90 - !! Adapted from Hal Levison's Swift routine coord_vb2vh.f - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - ! Internals - integer(I4B) :: i - - if (self%nbody == 0) return - - associate(pl => self, npl => self%nbody) - cb%vb(:) = 0.0_DP - do i = npl, 1, -1 - cb%vb(:) = cb%vb(:) - pl%Gmass(i) * pl%vb(:, i) / cb%Gmass - end do - do concurrent(i = 1:npl) - pl%vh(:, i) = pl%vb(:, i) - cb%vb(:) - end do - end associate - - return - end subroutine util_coord_vb2vh_pl - - - module subroutine util_coord_vb2vh_tp(self, vbcb) - !! author: David A. Minton - !! - !! Convert test particles from barycentric to heliocentric coordinates (velocity only) - !! - !! Adapted from David E. Kaufmann's Swifter routine coord_vb2vh_tp.f90 - !! Adapted from Hal Levison's Swift routine coord_vb2h_tp.f - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - real(DP), dimension(:), intent(in) :: vbcb !! Barycentric velocity of the central body - - if (self%nbody == 0) return - - associate(tp => self, ntp => self%nbody) - where (tp%lmask(1:ntp)) - tp%vh(1, 1:ntp) = tp%vb(1, 1:ntp) - vbcb(1) - tp%vh(2, 1:ntp) = tp%vb(2, 1:ntp) - vbcb(2) - tp%vh(3, 1:ntp) = tp%vb(3, 1:ntp) - vbcb(3) - end where - end associate - - return - end subroutine util_coord_vb2vh_tp - - - module subroutine util_coord_vh2vb_pl(self, cb) - !! author: David A. Minton - !! - !! Convert massive bodies from heliocentric to barycentric coordinates (velocity only) - !! - !! Adapted from David E. Kaufmann's Swifter routine coord_vh2vb.f90 - !! Adapted from Hal Levison's Swift routine coord_vh2b.f - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - ! Internals - integer(I4B) :: i - real(DP) :: Gmtot - - if (self%nbody == 0) return - - associate(pl => self, npl => self%nbody) - Gmtot = cb%Gmass + sum(pl%Gmass(1:npl)) - cb%vb(:) = 0.0_DP - do i = 1, npl - cb%vb(:) = cb%vb(:) - pl%Gmass(i) * pl%vh(:, i) - end do - cb%vb(:) = cb%vb(:) / Gmtot - do concurrent(i = 1:npl) - pl%vb(:, i) = pl%vh(:, i) + cb%vb(:) - end do - end associate - - return - end subroutine util_coord_vh2vb_pl - - - module subroutine util_coord_vh2vb_tp(self, vbcb) - !! author: David A. Minton - !! - !! Convert test particles from heliocentric to barycentric coordinates (velocity only) - !! - !! Adapted from David E. Kaufmann's Swifter routine coord_vh2vb_tp.f90 - !! Adapted from Hal Levison's Swift routine coord_vh2b_tp.f - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - real(DP), dimension(:), intent(in) :: vbcb !! Barycentric velocity of the central body - - if (self%nbody == 0) return - - associate(tp => self, ntp => self%nbody) - where (tp%lmask(1:ntp)) - tp%vb(1, 1:ntp) = tp%vh(1, 1:ntp) + vbcb(1) - tp%vb(2, 1:ntp) = tp%vh(2, 1:ntp) + vbcb(2) - tp%vb(3, 1:ntp) = tp%vh(3, 1:ntp) + vbcb(3) - end where - end associate - - return - end subroutine util_coord_vh2vb_tp - - - module subroutine util_coord_xh2xb_pl(self, cb) - !! author: David A. Minton - !! - !! Convert position vectors of massive bodies from heliocentric to barycentric coordinates (position only) - !! - !! Adapted from David E. Kaufmann's Swifter routine coord_h2b.f90 - !! Adapted from Hal Levison's Swift routine coord_h2b.f - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - ! Internals - integer(I4B) :: i - real(DP) :: Gmtot - real(DP), dimension(NDIM) :: xtmp - - if (self%nbody == 0) return - associate(pl => self, npl => self%nbody) - Gmtot = cb%Gmass - xtmp(:) = 0.0_DP - do i = 1, npl - if (pl%status(i) == INACTIVE) cycle - Gmtot = Gmtot + pl%Gmass(i) - xtmp(:) = xtmp(:) + pl%Gmass(i) * pl%xh(:,i) - end do - cb%xb(:) = -xtmp(:) / Gmtot - do i = 1, npl - if (pl%status(i) == INACTIVE) cycle - pl%xb(:,i) = pl%xh(:,i) + cb%xb(:) - end do - end associate - - return - end subroutine util_coord_xh2xb_pl - - - module subroutine util_coord_xh2xb_tp(self, cb) - !! author: David A. Minton - !! - !! Convert test particles from heliocentric to barycentric coordinates (position only) - !! - !! Adapted from David E. Kaufmann's Swifter routine coord_h2b_tp.f90 - !! Adapted from Hal Levison's Swift routine coord_h2b_tp.f - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_cb), intent(in) :: cb !! Swiftest central body object - ! Internals - integer(I4B) :: i - - if (self%nbody == 0) return - associate(tp => self, ntp => self%nbody) - do concurrent (i = 1:ntp, tp%status(i) /= INACTIVE) - tp%xb(:, i) = tp%xh(:, i) + cb%xb(:) - end do - end associate - - return - end subroutine util_coord_xh2xb_tp - -end submodule s_util_coord \ No newline at end of file diff --git a/src/util/util_copy.f90 b/src/util/util_copy.f90 deleted file mode 100644 index 2266396fb..000000000 --- a/src/util/util_copy.f90 +++ /dev/null @@ -1,82 +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. - -submodule(swiftest_classes) s_util_copy - use swiftest -contains - - module subroutine util_copy_particle_info(self, source) - !! author: David A. Minton - !! - !! Copies one set of information object components into another, component-by-component - implicit none - class(swiftest_particle_info), intent(inout) :: self - class(swiftest_particle_info), intent(in) :: source - - call self%set_value(& - name = source%name, & - particle_type = source%particle_type, & - status = source%status, & - origin_type = source%origin_type, & - origin_time = source%origin_time, & - collision_id = source%collision_id, & - origin_xh = source%origin_xh(:), & - origin_vh = source%origin_vh(:), & - discard_time = source%discard_time, & - discard_xh = source%discard_xh(:), & - discard_vh = source%discard_vh(:), & - discard_body_id = source%discard_body_id & - ) - - return - end subroutine util_copy_particle_info - - - module subroutine util_copy_particle_info_arr(source, dest, idx) - !! author: David A. Minton - !! - !! Copies contents from an array of one particle information objects to another. - 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 - ! Internals - integer(I4B) :: i, j, n, nsource, ndest - - if (size(source) == 0) return - - if (present(idx)) then - n = size(idx) - else - n = size(source) - end if - - nsource = size(source) - ndest = size(dest) - - if ((n == 0) .or. (n > ndest) .or. (n > nsource)) then - write(*,*) 'Particle info copy operation failed. n, nsource, ndest: ',n, nsource, ndest - return - end if - - do i = 1, n - if (present(idx)) then - j = idx(i) - else - j = i - end if - call dest(i)%copy(source(j)) - end do - - return - end subroutine util_copy_particle_info_arr - - - -end submodule s_util_copy diff --git a/src/util/util_dealloc.f90 b/src/util/util_dealloc.f90 deleted file mode 100644 index 107a7c478..000000000 --- a/src/util/util_dealloc.f90 +++ /dev/null @@ -1,112 +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. - -submodule (swiftest_classes) s_util_dealloc - use swiftest -contains - - module subroutine util_dealloc_body(self) - !! author: David A. Minton - !! - !! Finalize the swiftest body object - deallocates all allocatables - implicit none - ! Argument - class(swiftest_body), intent(inout) :: self - - if (allocated(self%info)) deallocate(self%info) - if (allocated(self%id)) deallocate(self%id) - if (allocated(self%status)) deallocate(self%status) - if (allocated(self%ldiscard)) deallocate(self%ldiscard) - if (allocated(self%lmask)) deallocate(self%lmask) - if (allocated(self%mu)) deallocate(self%mu) - if (allocated(self%xh)) deallocate(self%xh) - if (allocated(self%vh)) deallocate(self%vh) - if (allocated(self%xb)) deallocate(self%xb) - if (allocated(self%vb)) deallocate(self%vb) - if (allocated(self%ah)) deallocate(self%ah) - if (allocated(self%aobl)) deallocate(self%aobl) - if (allocated(self%agr)) deallocate(self%agr) - if (allocated(self%atide)) deallocate(self%atide) - if (allocated(self%ir3h)) deallocate(self%ir3h) - if (allocated(self%a)) deallocate(self%a) - if (allocated(self%e)) deallocate(self%e) - if (allocated(self%e)) deallocate(self%e) - if (allocated(self%inc)) deallocate(self%inc) - if (allocated(self%capom)) deallocate(self%capom) - if (allocated(self%omega)) deallocate(self%omega) - if (allocated(self%capm)) deallocate(self%capm) - - return - end subroutine util_dealloc_body - - - module subroutine util_dealloc_pl(self) - !! author: David A. Minton - !! - !! Finalize the swiftest massive body object - deallocates all allocatables - implicit none - ! Argument - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - - if (allocated(self%mass)) deallocate(self%mass) - if (allocated(self%Gmass)) deallocate(self%Gmass) - if (allocated(self%rhill)) deallocate(self%rhill) - if (allocated(self%renc)) deallocate(self%renc) - if (allocated(self%radius)) deallocate(self%radius) - if (allocated(self%density)) deallocate(self%density) - if (allocated(self%rot)) deallocate(self%rot) - if (allocated(self%Ip)) deallocate(self%Ip) - if (allocated(self%k2)) deallocate(self%k2) - if (allocated(self%Q)) deallocate(self%Q) - if (allocated(self%tlag)) deallocate(self%tlag) - if (allocated(self%k_plpl)) deallocate(self%k_plpl) - - call util_dealloc_body(self) - - return - end subroutine util_dealloc_pl - - - module subroutine util_dealloc_system(self) - !! author: David A. Minton - !! - !! Finalize the swiftest nbody system object - deallocates all allocatables - implicit none - ! Argument - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - - if (allocated(self%cb)) deallocate(self%cb) - if (allocated(self%pl)) deallocate(self%pl) - if (allocated(self%tp)) deallocate(self%tp) - if (allocated(self%tp_discards)) deallocate(self%tp_discards) - if (allocated(self%pl_discards)) deallocate(self%pl_discards) - - return - end subroutine util_dealloc_system - - - module subroutine util_dealloc_tp(self) - !! author: David A. Minton - !! - !! Finalize the swiftest test particle object - deallocates all allocatables - implicit none - ! Argument - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - - if (allocated(self%isperi)) deallocate(self%isperi) - if (allocated(self%peri)) deallocate(self%peri) - if (allocated(self%atp)) deallocate(self%atp) - if (allocated(self%k_pltp)) deallocate(self%k_pltp) - - call util_dealloc_body(self) - - return - end subroutine util_dealloc_tp - -end submodule s_util_dealloc \ No newline at end of file diff --git a/src/util/util_exit.f90 b/src/util/util_exit.f90 deleted file mode 100644 index 61dacdf99..000000000 --- a/src/util/util_exit.f90 +++ /dev/null @@ -1,45 +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. - -submodule (swiftest_classes) s_util_exit - use swiftest -contains - - module subroutine util_exit(code) - !! author: David A. Minton - !! - !! Print termination message and exit program - !! - !! Adapted from David E. Kaufmann's Swifter routine: util_exit.f90 - !! Adapted from Hal Levison's Swift routine util_exit.f - implicit none - ! Arguments - integer(I4B), intent(in) :: code - ! Internals - character(*), parameter :: BAR = '("------------------------------------------------")' - - select case(code) - case(SUCCESS) - write(*, SUCCESS_MSG) VERSION_NUMBER - write(*, BAR) - case(USAGE) - write(*, USAGE_MSG) - case(HELP) - write(*, HELP_MSG) - case default - write(*, FAIL_MSG) VERSION_NUMBER - write(*, BAR) - error stop - end select - - stop - - end subroutine util_exit - -end submodule s_util_exit diff --git a/src/util/util_fill.f90 b/src/util/util_fill.f90 deleted file mode 100644 index deb78f4ee..000000000 --- a/src/util/util_fill.f90 +++ /dev/null @@ -1,256 +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. - -submodule (swiftest_classes) s_util_fill - use swiftest -contains - - module subroutine 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 - 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 - - if (.not.allocated(keeps) .or. .not.allocated(inserts)) return - - keeps(:) = unpack(keeps(:), .not.lfill_list(:), keeps(:)) - keeps(:) = unpack(inserts(:), lfill_list(:), keeps(:)) - - return - end subroutine util_fill_arr_char_string - - module subroutine 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 - 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 - - if (.not.allocated(keeps) .or. .not.allocated(inserts)) return - - keeps(:) = unpack(keeps(:), .not.lfill_list(:), keeps(:)) - keeps(:) = unpack(inserts(:), lfill_list(:), keeps(:)) - - return - end subroutine util_fill_arr_DP - - module subroutine 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 - 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 - ! Internals - integer(I4B) :: i - - if (.not.allocated(keeps) .or. .not.allocated(inserts)) return - - do i = 1, NDIM - keeps(i,:) = unpack(keeps(i,:), .not.lfill_list(:), keeps(i,:)) - keeps(i,:) = unpack(inserts(i,:), lfill_list(:), keeps(i,:)) - end do - - return - end subroutine util_fill_arr_DPvec - - module subroutine 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 - 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 - - if (.not.allocated(keeps) .or. .not.allocated(inserts)) return - - keeps(:) = unpack(keeps(:), .not.lfill_list(:), keeps(:)) - keeps(:) = unpack(inserts(:), lfill_list(:), keeps(:)) - - return - end subroutine util_fill_arr_I4B - - - module subroutine util_fill_arr_info(keeps, inserts, lfill_list) - !! author: David A. Minton - !! - !! Performs a fill operation on a single array of particle origin information types - !! This is the inverse of a spill operation - implicit none - ! Arguments - 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 - ! Internals - integer(I4B), dimension(:), allocatable :: insert_idx - integer(I4B) :: i, nkeep, ninsert - - if (.not.allocated(keeps) .or. .not.allocated(inserts)) return - - nkeep = size(keeps) - ninsert = count(lfill_list) - - allocate(insert_idx(ninsert)) - - insert_idx(:) = pack([(i, i = 1, nkeep)], lfill_list) - call util_copy_particle_info_arr(inserts, keeps, insert_idx) - - return - end subroutine util_fill_arr_info - - - module subroutine 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 - 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 - - if (.not.allocated(keeps) .or. .not.allocated(inserts)) return - - keeps(:) = unpack(keeps(:), .not.lfill_list(:), keeps(:)) - keeps(:) = unpack(inserts(:), lfill_list(:), keeps(:)) - - return - end subroutine util_fill_arr_logical - - - module subroutine util_fill_body(self, inserts, lfill_list) - !! author: David A. Minton - !! - !! Insert new Swiftest generic particle structure into an old one. - !! This is the inverse of a spill operation. - implicit none - ! Arguments - class(swiftest_body), intent(inout) :: self !! Swiftest generic 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 - - ! For each component, pack the discarded bodies into the discard object and do the inverse with the keeps - !> Fill all the common components - associate(keeps => self) - call util_fill(keeps%id, inserts%id, lfill_list) - call util_fill(keeps%info, inserts%info, lfill_list) - call util_fill(keeps%status, inserts%status, lfill_list) - call util_fill(keeps%ldiscard, inserts%ldiscard, lfill_list) - call util_fill(keeps%lmask, inserts%lmask, lfill_list) - call util_fill(keeps%mu, inserts%mu, lfill_list) - call util_fill(keeps%xh, inserts%xh, lfill_list) - call util_fill(keeps%vh, inserts%vh, lfill_list) - call util_fill(keeps%xb, inserts%xb, lfill_list) - call util_fill(keeps%vb, inserts%vb, lfill_list) - call util_fill(keeps%ah, inserts%ah, lfill_list) - call util_fill(keeps%aobl, inserts%aobl, lfill_list) - call util_fill(keeps%agr, inserts%agr, lfill_list) - call util_fill(keeps%atide, inserts%atide, lfill_list) - call util_fill(keeps%a, inserts%a, lfill_list) - call util_fill(keeps%e, inserts%e, lfill_list) - call util_fill(keeps%inc, inserts%inc, lfill_list) - call util_fill(keeps%capom, inserts%capom, lfill_list) - call util_fill(keeps%omega, inserts%omega, lfill_list) - call util_fill(keeps%capm, inserts%capm, lfill_list) - - ! This is the base class, so will be the last to be called in the cascade. - keeps%nbody = size(keeps%id(:)) - end associate - - return - end subroutine util_fill_body - - - module subroutine util_fill_pl(self, inserts, lfill_list) - !! author: David A. Minton - !! - !! Insert new Swiftest massive body structure into an old one. - !! This is the inverse of a spill operation. - implicit none - ! Arguments - 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 - - associate(keeps => self) - - select type (inserts) ! The standard requires us to select the type of both arguments in order to access all the components - class is (swiftest_pl) - !> Fill components specific to the massive body class - call util_fill(keeps%mass, inserts%mass, lfill_list) - call util_fill(keeps%Gmass, inserts%Gmass, lfill_list) - call util_fill(keeps%rhill, inserts%rhill, lfill_list) - call util_fill(keeps%renc, inserts%renc, lfill_list) - call util_fill(keeps%radius, inserts%radius, lfill_list) - call util_fill(keeps%density, inserts%density, lfill_list) - call util_fill(keeps%k2, inserts%k2, lfill_list) - call util_fill(keeps%Q, inserts%Q, lfill_list) - call util_fill(keeps%tlag, inserts%tlag, lfill_list) - call util_fill(keeps%xbeg, inserts%xbeg, lfill_list) - call util_fill(keeps%vbeg, inserts%vbeg, lfill_list) - call util_fill(keeps%Ip, inserts%Ip, lfill_list) - call util_fill(keeps%rot, inserts%rot, lfill_list) - - if (allocated(keeps%k_plpl)) deallocate(keeps%k_plpl) - - call util_fill_body(keeps, inserts, lfill_list) - class default - write(*,*) 'Error! fill method called for incompatible return type on swiftest_pl' - end select - end associate - - return - end subroutine util_fill_pl - - - module subroutine util_fill_tp(self, inserts, lfill_list) - !! author: David A. Minton - !! - !! Insert new Swiftest test particle structure into an old one. - !! This is the inverse of a fill operation. - implicit none - ! Arguments - 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 - - associate(keeps => self) - select type(inserts) - class is (swiftest_tp) - !> Spill components specific to the test particle class - call util_fill(keeps%isperi, inserts%isperi, lfill_list) - call util_fill(keeps%peri, inserts%peri, lfill_list) - call util_fill(keeps%atp, inserts%atp, lfill_list) - - call util_fill_body(keeps, inserts, lfill_list) - class default - write(*,*) 'Error! fill method called for incompatible return type on swiftest_tp' - end select - end associate - - return - end subroutine util_fill_tp - -end submodule s_util_fill \ No newline at end of file diff --git a/src/util/util_flatten.f90 b/src/util/util_flatten.f90 deleted file mode 100644 index 36fee2489..000000000 --- a/src/util/util_flatten.f90 +++ /dev/null @@ -1,148 +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. - -submodule (swiftest_classes) s_util_index - use swiftest -contains - - pure module subroutine util_flatten_eucl_ij_to_k(n, i, j, k) - !! author: Jacob R. Elliott and David A. Minton - !! - !! Turns i,j indices into k index for use in the Euclidean distance matrix for pl-pl interactions. - !! - !! Reference: - !! - !! Mélodie Angeletti, Jean-Marie Bonny, Jonas Koko. Parallel Euclidean distance matrix computation on big datasets *. - !! 2019. hal-0204751 - implicit none - ! Arguments - 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 - ! Internals - integer(I8B) :: i8, j8, n8 - - i8 = int(i, kind=I8B) - j8 = int(j, kind=I8B) - n8 = int(n, kind=I8B) - k = (i8 - 1_I8B) * n8 - i8 * (i8 - 1_I8B) / 2_I8B + (j8 - i8) - - return - end subroutine util_flatten_eucl_ij_to_k - - - pure module subroutine util_flatten_eucl_k_to_ij(n, k, i, j) - !! author: Jacob R. Elliott and David A. Minton - !! - !! Turns k index into i,j indices for use in the Euclidean distance matrix for pl-pl interactions. - !! - !! Reference: - !! - !! Mélodie Angeletti, Jean-Marie Bonny, Jonas Koko. Parallel Euclidean distance matrix computation on big datasets *. - !! 2019. hal-0204751 - implicit none - ! Arguments - 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 - ! Internals - integer(I8B) :: kp, p, i8, j8, n8 - - n8 = int(n, kind=I8B) - - kp = n8 * (n8 - 1_I8B) / 2_I8B - k - p = floor((sqrt(1._DP + 8_I8B * kp) - 1_I8B) / 2_I8B) - i8 = n8 - 1_I8B - p - j8 = k - (n8 - 1_I8B) * (n8 - 2_I8B) / 2_I8B + p * (p + 1_I8B) / 2_I8B + 1_I8B - - i = int(i8, kind=I4B) - j = int(j8, kind=I4B) - - return - end subroutine util_flatten_eucl_k_to_ij - - - module subroutine util_flatten_eucl_plpl(self, param) - !! author: Jacob R. Elliott and David A. Minton - !! - !! Turns i,j indices into k index for use in the Euclidean distance matrix for pl-pl interactions for a Swiftest massive body object - !! - !! Reference: - !! - !! Mélodie Angeletti, Jean-Marie Bonny, Jonas Koko. Parallel Euclidean distance matrix computation on big datasets *. - !! 2019. hal-0204751 - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i, j, err - integer(I8B) :: k, npl - - npl = int(self%nbody, kind=I8B) - associate(nplpl => self%nplpl) - nplpl = npl * (npl - 1_I8B) / 2_I8B ! number of entries in a strict lower triangle, npl x npl - if (param%lflatten_interactions) then - if (allocated(self%k_plpl)) deallocate(self%k_plpl) ! Reset the index array if it's been set previously - allocate(self%k_plpl(2, nplpl), stat=err) - if (err /=0) then ! An error occurred trying to allocate this big array. This probably means it's too big to fit in memory, and so we will force the run back into triangular mode - param%lflatten_interactions = .false. - else - do concurrent (i=1:npl, j=1:npl, j>i) - call util_flatten_eucl_ij_to_k(self%nbody, i, j, k) - self%k_plpl(1, k) = i - self%k_plpl(2, k) = j - end do - end if - end if - end associate - - return - end subroutine util_flatten_eucl_plpl - - - module subroutine util_flatten_eucl_pltp(self, pl, param) - !! author: Jacob R. Elliott and David A. Minton - !! - !! Turns i,j indices into k index for use in the Euclidean distance matrix for pl-tp interactions - !! - !! Reference: - !! - !! Mélodie Angeletti, Jean-Marie Bonny, Jonas Koko. Parallel Euclidean distance matrix computation on big datasets *. - !! 2019. hal-0204751 - implicit none - ! Arguments - 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 - ! Internals - integer(I8B) :: i, j, counter, npl, ntp - - ntp = int(self%nbody, kind=I8B) - npl = int(pl%nbody, kind=I8B) - associate(npltp => self%npltp) - npltp = npl * ntp - if (allocated(self%k_pltp)) deallocate(self%k_pltp) ! Reset the index array if it's been set previously - allocate(self%k_pltp(2, npltp)) - do i = 1_I8B, npl - counter = (i - 1_I8B) * npl + 1_I8B - do j = 1_I8B, ntp - self%k_pltp(1, counter) = i - self%k_pltp(2, counter) = j - counter = counter + 1_I8B - end do - end do - end associate - - return - end subroutine util_flatten_eucl_pltp - -end submodule s_util_index diff --git a/src/util/util_get_energy_momentum.f90 b/src/util/util_get_energy_momentum.f90 deleted file mode 100644 index 621ea80a6..000000000 --- a/src/util/util_get_energy_momentum.f90 +++ /dev/null @@ -1,221 +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. - -submodule (swiftest_classes) s_util_get_energy_momentum - use swiftest -contains - module subroutine util_get_energy_momentum_system(self, param) - !! author: David A. Minton - !! - !! Compute total system angular momentum vector and kinetic, potential and total system energy - !! - !! Adapted from David E. Kaufmann Swifter routine symba_energy_eucl.f90 - !! - !! Adapted from Martin Duncan's Swift routine anal_energy.f - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i - integer(I8B) :: nplpl - real(DP) :: kecb, kespincb - real(DP), dimension(self%pl%nbody) :: kepl, kespinpl - real(DP), dimension(self%pl%nbody) :: Lplorbitx, Lplorbity, Lplorbitz - real(DP), dimension(self%pl%nbody) :: Lplspinx, Lplspiny, Lplspinz - real(DP), dimension(NDIM) :: Lcborbit, Lcbspin - real(DP) :: hx, hy, hz - - associate(system => self, pl => self%pl, npl => self%pl%nbody, cb => self%cb) - nplpl = pl%nplpl - system%Lorbit(:) = 0.0_DP - system%Lspin(:) = 0.0_DP - system%Ltot(:) = 0.0_DP - system%ke_orbit = 0.0_DP - system%ke_spin = 0.0_DP - - kepl(:) = 0.0_DP - Lplorbitx(:) = 0.0_DP - Lplorbity(:) = 0.0_DP - Lplorbitz(:) = 0.0_DP - Lplspinx(:) = 0.0_DP - Lplspiny(:) = 0.0_DP - Lplspinz(:) = 0.0_DP - - pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE - - system%GMtot = cb%Gmass + sum(pl%Gmass(1:npl), pl%lmask(1:npl)) - kecb = cb%mass * dot_product(cb%vb(:), cb%vb(:)) - Lcborbit(:) = cb%mass * (cb%xb(:) .cross. cb%vb(:)) - - do concurrent (i = 1:npl, pl%lmask(i)) - hx = pl%xb(2,i) * pl%vb(3,i) - pl%xb(3,i) * pl%vb(2,i) - hy = pl%xb(3,i) * pl%vb(1,i) - pl%xb(1,i) * pl%vb(3,i) - hz = pl%xb(1,i) * pl%vb(2,i) - pl%xb(2,i) * pl%vb(1,i) - - ! Angular momentum from orbit - Lplorbitx(i) = pl%mass(i) * hx - Lplorbity(i) = pl%mass(i) * hy - Lplorbitz(i) = pl%mass(i) * hz - - ! Kinetic energy from orbit - kepl(i) = pl%mass(i) * dot_product(pl%vb(:,i), pl%vb(:,i)) - end do - - if (param%lrotation) then - kespincb = cb%mass * cb%Ip(3) * cb%radius**2 * dot_product(cb%rot(:), cb%rot(:)) - - ! 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(:) - - do concurrent (i = 1:npl, pl%lmask(i)) - ! Currently we assume that the rotation pole is the 3rd principal axis - ! Angular momentum from spin - Lplspinx(i) = pl%mass(i) * pl%Ip(3,i) * pl%radius(i)**2 * pl%rot(1,i) - Lplspiny(i) = pl%mass(i) * pl%Ip(3,i) * pl%radius(i)**2 * pl%rot(2,i) - Lplspinz(i) = pl%mass(i) * pl%Ip(3,i) * pl%radius(i)**2 * pl%rot(3,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 - else - kespincb = 0.0_DP - kespinpl(:) = 0.0_DP - end if - - if (param%lflatten_interactions) then - call util_get_energy_potential_flat(npl, nplpl, pl%k_plpl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%xb, system%pe) - else - call util_get_energy_potential_triangular(npl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%xb, system%pe) - end if - - ! Potential energy from the oblateness term - if (param%loblatecb) then - call system%obl_pot() - system%pe = system%pe + system%oblpot - end if - - system%ke_orbit = 0.5_DP * (kecb + sum(kepl(1:npl), pl%lmask(1:npl))) - if (param%lrotation) system%ke_spin = 0.5_DP * (kespincb + sum(kespinpl(1:npl), pl%lmask(1:npl))) - - system%Lorbit(1) = Lcborbit(1) + sum(Lplorbitx(1:npl), pl%lmask(1:npl)) - system%Lorbit(2) = Lcborbit(2) + sum(Lplorbity(1:npl), pl%lmask(1:npl)) - system%Lorbit(3) = Lcborbit(3) + sum(Lplorbitz(1:npl), pl%lmask(1:npl)) - - if (param%lrotation) then - system%Lspin(1) = Lcbspin(1) + sum(Lplspinx(1:npl), pl%lmask(1:npl)) - system%Lspin(2) = Lcbspin(2) + sum(Lplspiny(1:npl), pl%lmask(1:npl)) - system%Lspin(3) = Lcbspin(3) + sum(Lplspinz(1:npl), pl%lmask(1:npl)) - end if - - system%te = system%ke_orbit + system%ke_spin + system%pe - system%Ltot(:) = system%Lorbit(:) + system%Lspin(:) - end associate - - return - end subroutine util_get_energy_momentum_system - - - subroutine util_get_energy_potential_flat(npl, nplpl, k_plpl, lmask, GMcb, Gmass, mass, xb, pe) - !! author: David A. Minton - !! - !! Compute total system potential energy - implicit none - ! Arguments - integer(I4B), intent(in) :: npl - integer(I8B), intent(in) :: nplpl - integer(I4B), dimension(:,:), intent(in) :: k_plpl - logical, dimension(:), intent(in) :: lmask - real(DP), intent(in) :: GMcb - real(DP), dimension(:), intent(in) :: Gmass - real(DP), dimension(:), intent(in) :: mass - real(DP), dimension(:,:), intent(in) :: xb - real(DP), intent(out) :: pe - ! Internals - integer(I4B) :: i, j - integer(I8B) :: k - real(DP), dimension(npl) :: pecb - real(DP), dimension(nplpl) :: pepl - logical, dimension(nplpl) :: lstatpl - - ! Do the central body potential energy component first - where(.not. lmask(1:npl)) - pecb(1:npl) = 0.0_DP - end where - - do concurrent(i = 1:npl, lmask(i)) - pecb(i) = -GMcb * mass(i) / norm2(xb(:,i)) - end do - - !$omp parallel do default(private) schedule(static)& - !$omp shared(k_plpl, xb, mass, Gmass, pepl, lstatpl, lmask) & - !$omp firstprivate(nplpl) - do k = 1, nplpl - i = k_plpl(1,k) - j = k_plpl(2,k) - lstatpl(k) = (lmask(i) .and. lmask(j)) - if (lstatpl(k)) then - pepl(k) = -(Gmass(i) * mass(j)) / norm2(xb(:, i) - xb(:, j)) - else - pepl(k) = 0.0_DP - end if - end do - !$omp end parallel do - - pe = sum(pepl(:), lstatpl(:)) + sum(pecb(1:npl), lmask(1:npl)) - - return - end subroutine util_get_energy_potential_flat - - - subroutine util_get_energy_potential_triangular(npl, lmask, GMcb, Gmass, mass, xb, pe) - !! author: David A. Minton - !! - !! Compute total system potential energy - implicit none - ! Arguments - integer(I4B), intent(in) :: npl - logical, dimension(:), intent(in) :: lmask - real(DP), intent(in) :: GMcb - real(DP), dimension(:), intent(in) :: Gmass - real(DP), dimension(:), intent(in) :: mass - real(DP), dimension(:,:), intent(in) :: xb - real(DP), intent(out) :: pe - ! Internals - integer(I4B) :: i, j - real(DP), dimension(npl) :: pecb, pepl - - ! Do the central body potential energy component first - where(.not. lmask(1:npl)) - pecb(1:npl) = 0.0_DP - end where - - do concurrent(i = 1:npl, lmask(i)) - pecb(i) = -GMcb * mass(i) / norm2(xb(:,i)) - end do - - pe = 0.0_DP - !$omp parallel do default(private) schedule(static)& - !$omp shared(lmask, Gmass, mass, xb) & - !$omp firstprivate(npl) & - !$omp reduction(+:pe) - do i = 1, npl - if (lmask(i)) then - do concurrent(j = i+1:npl, lmask(i) .and. lmask(j)) - pepl(j) = - (Gmass(i) * mass(j)) / norm2(xb(:, i) - xb(:, j)) - end do - pe = pe + sum(pepl(i+1:npl), lmask(i+1:npl)) - end if - end do - !$omp end parallel do - pe = pe + sum(pecb(1:npl), lmask(1:npl)) - - return - end subroutine util_get_energy_potential_triangular - -end submodule s_util_get_energy_momentum diff --git a/src/util/util_index_array.f90 b/src/util/util_index_array.f90 deleted file mode 100644 index b59e829e1..000000000 --- a/src/util/util_index_array.f90 +++ /dev/null @@ -1,47 +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. - -submodule (swiftest_classes) s_util_index_array - use swiftest -contains - - module subroutine util_index_array(ind_arr, n) - !! author: David A. Minton - !! - !! Creates or resizes an index array of size n where ind_arr = [1, 2, ... n]. - !! This subroutine assumes that if ind_arr is already allocated, it is a pre-existing index array of a different size. - implicit none - ! Arguments - 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 - ! Internals - integer(I4B) :: nold, i - integer(I4B), dimension(:), allocatable :: itmp - - if (allocated(ind_arr)) then - nold = size(ind_arr) - if (nold == n) return ! Nothing to do, so go home - else - nold = 0 - end if - - allocate(itmp(n)) - if (n >= nold) then - if (nold > 0) itmp(1:nold) = ind_arr(1:nold) - itmp(nold+1:n) = [(i, i = nold + 1, n)] - call move_alloc(itmp, ind_arr) - else - itmp(1:n) = ind_arr(1:n) - call move_alloc(itmp, ind_arr) - end if - - return - end subroutine util_index_array - -end submodule s_util_index_array \ No newline at end of file diff --git a/src/util/util_minimize_bfgs.f90 b/src/util/util_minimize_bfgs.f90 deleted file mode 100644 index cd9e8f8bc..000000000 --- a/src/util/util_minimize_bfgs.f90 +++ /dev/null @@ -1,592 +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. - -submodule (swiftest_classes) s_util_minimize_bfgs - use swiftest -contains - module function util_minimize_bfgs(f, N, x0, eps, maxloop, lerr) result(x1) - !! author: David A. Minton - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This function implements the Broyden-Fletcher-Goldfarb-Shanno method to determine the minimum of a function of N variables. - !! It recieves as input: - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! N : Number of variables of function f - !! x0 : Initial starting value of x - !! eps : Accuracy of 1 - dimensional minimization at each step - !! maxloop : Maximum number of loops to attempt to find a solution - !! The outputs include - !! lerr : Returns .true. if it could not find the minimum - !! Returns - !! x1 : Final minimum (all 0 if none found) - !! 0 = No miniumum found - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - use, intrinsic :: ieee_exceptions - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0 - real(DP), intent(in) :: eps - integer(I4B), intent(in) :: maxloop - logical, intent(out) :: lerr - ! Result - real(DP), dimension(:), allocatable :: x1 - ! Internals - integer(I4B) :: i, j, k, l, conv - real(DP), parameter :: graddelta = 1e-4_DP !! Delta x for gradient calculations - real(DP), dimension(N) :: S !! Direction vectors - real(DP), dimension(N,N) :: H !! Approximated inverse Hessian matrix - real(DP), dimension(N) :: grad1 !! gradient of f - real(DP), dimension(N) :: grad0 !! old value of gradient - real(DP) :: astar !! 1D minimized value - real(DP), dimension(N) :: y, P - real(DP), dimension(N,N) :: PP, PyH, HyP - real(DP), save :: yHy, Py - type(ieee_status_type) :: original_fpe_status - logical, dimension(:), allocatable :: fpe_flag - - call ieee_get_status(original_fpe_status) ! Save the original floating point exception status - call ieee_set_flag(ieee_all, .false.) ! Set all flags to quiet - allocate(fpe_flag(size(ieee_usual))) - - lerr = .false. - allocate(x1, source=x0) - ! Initialize approximate Hessian with the identity matrix (i.e. begin with method of steepest descent) - ! Get initial gradient and initialize arrays for updated values of gradient and x - H(:,:) = reshape([((0._DP, i=1, j-1), 1._DP, (0._DP, i=j+1, N), j=1, N)], [N,N]) - grad0 = gradf(f, N, x0(:), graddelta, lerr) - if (lerr) then - call ieee_set_status(original_fpe_status) - return - end if - grad1(:) = grad0(:) - do i = 1, maxloop - !check for convergence - conv = count(abs(grad1(:)) > eps) - if (conv == 0) exit - S(:) = -matmul(H(:,:), grad1(:)) - astar = minimize1D(f, x1, S, N, graddelta, lerr) - if (lerr) exit - ! Get new x values - P(:) = astar * S(:) - x1(:) = x1(:) + P(:) - ! Calculate new gradient - grad0(:) = grad1(:) - grad1 = gradf(f, N, x1, graddelta, lerr) - y(:) = grad1(:) - grad0(:) - Py = sum(P(:) * y(:)) - ! set up factors for H matrix update - yHy = 0._DP - !$omp do simd schedule(static)& - !$omp firstprivate(N, y, H) & - !$omp reduction(+:yHy) - do k = 1, N - do j = 1, N - yHy = yHy + y(j) * H(j,k) * y(k) - end do - end do - !$omp end do simd - ! prevent divide by zero (convergence) - if (abs(Py) < tiny(Py)) exit - ! set up update - PyH(:,:) = 0._DP - HyP(:,:) = 0._DP - !$omp parallel do default(private) schedule(static)& - !$omp shared(N, PP, P, y, H) & - !$omp reduction(+:PyH, HyP) - do k = 1, N - do j = 1, N - PP(j, k) = P(j) * P(k) - do l = 1, N - PyH(j, k) = PyH(j, k) + P(j) * y(l) * H(l,k) - HyP(j, k) = HyP(j, k) + P(k) * y(l) * H(j,l) - end do - end do - end do - !$omp end parallel do - ! update H matrix - H(:,:) = H(:,:) + ((1._DP - yHy / Py) * PP(:,:) - PyH(:,:) - HyP(:,:)) / Py - ! Normalize to prevent it from blowing up if it takes many iterations to find a solution - H(:,:) = H(:,:) / norm2(H(:,:)) - ! Stop everything if there are any exceptions to allow the routine to fail gracefully - call ieee_get_flag(ieee_usual, fpe_flag) - if (any(fpe_flag)) exit - if (i == maxloop) then - lerr = .true. - end if - end do - call ieee_get_flag(ieee_usual, fpe_flag) - lerr = lerr .or. any(fpe_flag) - call ieee_set_status(original_fpe_status) - - return - - contains - - function gradf(f, N, x1, dx, lerr) result(grad) - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! Purpose: Estimates the gradient of a function using a central difference - !! approximation - !! Inputs: - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! N : number of variables N - !! x1 : x value array - !! dx : step size to use when calculating derivatives - !! Outputs: - !! lerr : .true. if an error occurred. Otherwise returns .false. - !! Returns - !! grad : N sized array containing estimated gradient of f at x1 - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x1 - real(DP), intent(in) :: dx - logical, intent(out) :: lerr - ! Result - real(DP), dimension(N) :: grad - ! Internals - integer(I4B) :: i, j - real(DP), dimension(N) :: xp, xm - real(DP) :: fp, fm - logical :: lerrp, lerrm - - do i = 1, N - do j = 1, N - if (j == i) then - xp(j) = x1(j) + dx - xm(j) = x1(j) - dx - else - xp(j) = x1(j) - xm(j) = x1(j) - end if - end do - select type (f) - class is (lambda_obj_err) - fp = f%eval(xp) - lerrp = f%lerr - fm = f%eval(xm) - lerrm = f%lerr - lerr = lerrp .or. lerrm - class is (lambda_obj) - fp = f%eval(xp) - fm = f%eval(xm) - lerr = .false. - end select - grad(i) = (fp - fm) / (2 * dx) - if (lerr) return - end do - return - end function gradf - - - function minimize1D(f, x0, S, N, eps, lerr) result(astar) - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This program find the minimum of a function of N variables in a single direction - !! S using in sequence: - !! 1. A Bracketing method - !! 2. The golden section method - !! 3. A quadratic polynomial fit - !! Inputs - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! x0 : Array of size N of initial x values - !! S : Array of size N that determines the direction of minimization - !! N : Number of variables of function f - !! eps : Accuracy of 1 - dimensional minimization at each step - !! Output - !! lerr : .true. if an error occurred. Otherwise returns .false. - !! Returns - !! astar : Final minimum along direction S - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: eps - logical, intent(out) :: lerr - ! Result - real(DP) :: astar - ! Internals - integer(I4B) :: num = 0 - real(DP), parameter :: step = 0.7_DP !! Bracketing method step size - real(DP), parameter :: gam = 1.2_DP !! Bracketing method expansion parameter - real(DP), parameter :: greduce = 0.2_DP !! Golden section method reduction factor - real(DP), parameter :: greduce2 = 0.1_DP ! Secondary golden section method reduction factor - real(DP) :: alo, ahi !! High and low values for 1 - D minimization routines - real(DP), parameter :: a0 = epsilon(1.0_DP) !! Initial guess of alpha - - alo = a0 - call bracket(f, x0, S, N, gam, step, alo, ahi, lerr) - if (lerr) then - !write(*,*) "BFGS bracketing step failed!" - return - end if - if (abs(alo - ahi) < eps) then - astar = alo - lerr = .false. - return - end if - call golden(f, x0, S, N, greduce, alo, ahi, lerr) - if (lerr) then - !write(*,*) "BFGS golden section step failed!" - return - end if - if (abs(alo - ahi) < eps) then - astar = alo - lerr = .false. - return - end if - call quadfit(f, x0, S, N, eps, alo, ahi, lerr) - if (lerr) then - !write(*,*) "BFGS quadfit failed!" - return - end if - if (abs(alo - ahi) < eps) then - astar = alo - lerr = .false. - return - end if - ! Quadratic fit method won't converge, so finish off with another golden section - call golden(f, x0, S, N, greduce2, alo, ahi, lerr) - if (.not. lerr) astar = (alo + ahi) / 2.0_DP - return - end function minimize1D - - - function n2one(f, x0, S, N, a, lerr) result(fnew) - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: a - logical, intent(out) :: lerr - - ! Return - real(DP) :: fnew - ! Internals - real(DP), dimension(N) :: xnew - integer(I4B) :: i - - xnew(:) = x0(:) + a * S(:) - fnew = f%eval(xnew(:)) - select type(f) - class is (lambda_obj_err) - lerr = f%lerr - class is (lambda_obj) - lerr = .false. - end select - return - end function n2one - - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - subroutine bracket(f, x0, S, N, gam, step, lo, hi, lerr) - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This subroutine brackets the minimum. It recieves as input: - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! x0 : Array of size N of initial x values - !! S : Array of size N that determines the direction of minimization - !! gam : expansion parameter - !! step : step size - !! lo : initial guess of lo bracket value - !! The outputs include - !! lo : lo bracket - !! hi : hi bracket - !! lerr : .true. if an error occurred. Otherwise returns .false. - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: gam, step - real(DP), intent(inout) :: lo - real(DP), intent(out) :: hi - logical, intent(out) :: lerr - ! Internals - real(DP) :: a0, a1, a2, atmp, da - real(DP) :: f0, f1, f2 - integer(I4B) :: i, j - integer(I4B), parameter :: MAXLOOP = 100 ! maximum number of loops before method is determined to have failed - real(DP), parameter :: eps = epsilon(lo) ! small number precision to test floating point equality - - ! set up initial bracket points - a0 = lo - da = step - a1 = a0 + da - a2 = a0 + 2 * da - f0 = n2one(f, x0, S, N, a0, lerr) - if (lerr) return - f1 = n2one(f, x0, S, N, a1, lerr) - if (lerr) return - f2 = n2one(f, x0, S, N, a2, lerr) - if (lerr) return - ! loop over bracket method until either min is bracketed method fails - do i = 1, MAXLOOP - if ((f0 > f1) .and. (f1 < f2)) then ! Minimum was found - lo = a0 - hi = a2 - return - else if ((f0 >= f1) .and. (f1 > f2)) then ! Function appears to decrease - da = da * gam - atmp = a2 + da - a0 = a1 - a1 = a2 - a2 = atmp - f0 = f1 - f1 = f2 - f2 = n2one(f, x0, S, N, a2, lerr) - else if ((f0 < f1) .and. (f1 <= f2)) then ! Function appears to increase - da = da * gam - atmp = a0 - da - a2 = a1 - a1 = a0 - a0 = atmp - f2 = f1 - f0 = n2one(f, x0, S, N, a0, lerr) - else if ((f0 < f1) .and. (f1 > f2)) then ! We are at a peak. Pick the direction that descends the fastest - da = da * gam - if (f2 > f0) then ! LHS is lower than RHS - atmp = a2 + da - a0 = a1 - a1 = a2 - a2 = atmp - f0 = f1 - f1 = f2 - f2 = n2one(f, x0, S, N, a2, lerr) - else ! RHS is lower than LHS - atmp = a0 - da - a2 = a1 - a1 = a0 - a0 = atmp - f2 = f1 - f1 = f2 - f0 = n2one(f, x0, S, N, a0, lerr) - end if - else if ((f0 > f1) .and. (abs(f2 - f1) <= eps)) then ! Decrasging but RHS equal - da = da * gam - atmp = a2 + da - a2 = atmp - f2 = n2one(f, x0, S, N, a2, lerr) - else if ((abs(f0 - f1) < eps) .and. (f1 < f2)) then ! Increasing but LHS equal - da = da * gam - atmp = a0 - da - a0 = atmp - f0 = n2one(f, x0, S, N, a0, lerr) - else ! all values equal. Expand in either direction and try again - a0 = a0 - da - a2 = a2 + da - f0 = n2one(f, x0, S, N, a0, lerr) - if (lerr) exit ! An error occurred while evaluating the function - f2 = n2one(f, x0, S, N, a2, lerr) - end if - if (lerr) exit ! An error occurred while evaluating the function - end do - lerr = .true. - return ! no minimum found - end subroutine bracket - - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - subroutine golden(f, x0, S, N, eps, lo, hi, lerr) - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This function uses the golden section method to reduce the starting interval lo, hi by some amount sigma. - !! It recieves as input: - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! x0 : Array of size N of initial x values - !! S : Array of size N that determines the direction of minimization - !! gam : expansion parameter - !! eps : reduction interval in range (0 < sigma < 1) such that: - !! hi(new) - lo(new) = eps * (hi(old) - lo(old)) - !! lo : initial guess of lo bracket value - !! The outputs include - !! lo : lo bracket - !! hi : hi bracket - !! lerr : .true. if an error occurred. Otherwise returns .false. - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: eps - real(DP), intent(inout) :: lo - real(DP), intent(out) :: hi - logical, intent(out) :: lerr - ! Internals - real(DP), parameter :: tau = 0.5_DP * (sqrt(5.0_DP) - 1.0_DP) ! Golden section constant - integer(I4B), parameter :: MAXLOOP = 40 ! maximum number of loops before method is determined to have failed (unlikely, but could occur if no minimum exists between lo and hi) - real(DP) :: i0 ! Initial interval value - real(DP) :: a1, a2 - real(DP) :: f1, f2 - integer(I4B) :: i, j - - i0 = hi - lo - a1 = hi - tau * i0 - a2 = lo + tau * i0 - f1 = n2one(f, x0, S, N, a1, lerr) - if (lerr) return - f2 = n2one(f, x0, S, N, a2, lerr) - if (lerr) return - do i = 1, MAXLOOP - if (abs((hi - lo) / i0) <= eps) return ! interval reduced to input amount - if (f2 > f1) then - hi = a2 - a2 = a1 - f2 = f1 - a1 = hi - tau * (hi - lo) - f1 = n2one(f, x0, S, N, a1, lerr) - else - lo = a1 - a1 = a2 - f2 = f1 - a2 = hi - (1.0_DP - tau) * (hi - lo) - f2 = n2one(f, x0, S, N, a2, lerr) - end if - if (lerr) exit - end do - lerr = .true. - return ! search took too many iterations - no minimum found - end subroutine golden - - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - subroutine quadfit(f, x0, S, N, eps, lo, hi, lerr) - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This function uses a quadratic polynomial fit to locate the minimum of a function - !! to some accuracy eps. It recieves as input: - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! lo : low bracket value - !! hi : high bracket value - !! eps : desired accuracy of final minimum location - !! The outputs include - !! lo : final minimum location - !! hi : final minimum location - !! Notes: Uses the ieee_exceptions intrinsic module to allow for graceful failure due to floating point exceptions, which won't terminate the run. - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: eps - real(DP), intent(inout) :: lo - real(DP), intent(out) :: hi - logical, intent(out) :: lerr - ! Internals - integer(I4B), parameter :: MAXLOOP = 20 ! maximum number of loops before method is determined to have failed. - real(DP) :: a1, a2, a3, astar ! three points for the polynomial fit and polynomial minimum - real(DP) :: f1, f2, f3, fstar ! three function values for the polynomial and polynomial minimum - real(DP), dimension(3) :: row_1, row_2, row_3, rhs, soln ! matrix for 3 equation solver (gaussian elimination) - real(DP), dimension(3,3) :: lhs - real(DP) :: d1, d2, d3, aold, denom, errval - integer(I4B) :: i - - lerr = .false. - ! Get initial a1, a2, a3 values - a1 = lo - a2 = lo + 0.5_DP * (hi - lo) - a3 = hi - aold = a1 - astar = a2 - f1 = n2one(f, x0, S, N, a1, lerr) - if (lerr) return - f2 = n2one(f, x0, S, N, a2, lerr) - if (lerr) return - f3 = n2one(f, x0, S, N, a3, lerr) - if (lerr) return - do i = 1, MAXLOOP - ! check to see if convergence is reached and exit - errval = abs((astar - aold) / astar) - call ieee_get_flag(ieee_usual, fpe_flag) - if (any(fpe_flag)) then - !write(*,*) 'quadfit fpe' - !write(*,*) 'aold : ',aold - !write(*,*) 'astar: ',astar - lerr = .true. - exit - end if - if (errval < eps) then - lo = astar - hi = astar - exit - end if - ! Set up system for gaussian elimination equation solver - row_1 = [1.0_DP, a1, a1**2] - row_2 = [1.0_DP, a2, a2**2] - row_3 = [1.0_DP, a3, a3**2] - rhs = [f1, f2, f3] - lhs(1, :) = row_1 - lhs(2, :) = row_2 - lhs(3, :) = row_3 - ! Solve system of equations - soln(:) = util_solve_linear_system(lhs, rhs, 3, lerr) - call ieee_set_flag(ieee_all, .false.) ! Set all flags back to quiet - call ieee_set_halting_mode(ieee_divide_by_zero, .false.) - if (lerr) then - !write(*,*) 'quadfit fpe:' - !write(*,*) 'util_solve_linear_system failed' - exit - end if - aold = astar - if (soln(2) == soln(3)) then ! Handles the case where they are both 0. 0/0 is an unhandled exception - astar = -0.5_DP - else - astar = -soln(2) / (2 * soln(3)) - end if - call ieee_get_flag(ieee_usual, fpe_flag) - if (any(fpe_flag)) then - !write(*,*) 'quadfit fpe' - !write(*,*) 'soln(2:3): ',soln(2:3) - !write(*,*) 'a1, a2, a3' - !write(*,*) a1, a2, a3 - !write(*,*) 'f1, f2, f3' - !write(*,*) f1, f2, f3 - lerr = .true. - exit - end if - fstar = n2one(f, x0, S, N, astar, lerr) - if (lerr) exit - ! keep the three closest a values to astar and discard the fourth - d1 = abs(a1 - astar) - d2 = abs(a2 - astar) - d3 = abs(a3 - astar) - - if (d1 > d2) then - if (d1 > d3) then - f1 = fstar - a1 = astar - else if (d3 > d2) then - f3 = fstar - a3 = astar - end if - else - if (d2 > d3) then - f2 = fstar - a2 = astar - else if (d3 > d1) then - f3 = fstar - a3 = astar - end if - end if - end do - if (lerr) return - lo = a1 - hi = a3 - return - end subroutine quadfit - - end function util_minimize_bfgs -end submodule s_util_minimize_bfgs \ No newline at end of file diff --git a/src/util/util_peri.f90 b/src/util/util_peri.f90 deleted file mode 100644 index bed29c58a..000000000 --- a/src/util/util_peri.f90 +++ /dev/null @@ -1,75 +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. - -submodule (swiftest_classes) s_util_peri - use swiftest -contains - - module subroutine util_peri_tp(self, system, param) - !! author: David A. Minton - !! - !! Determine system pericenter passages for test particles - !! Note: If the coordinate system used is barycentric, then this routine assumes that the barycentric coordinates in the - !! test particle structures are up-to-date and are not recomputed - !! - !! Adapted from David E. Kaufmann's Swifter routine: util_peri.f90 - !! Adapted from Hal Levison's Swift routine util_peri.f - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i - real(DP) :: e - real(DP), dimension(:), allocatable :: vdotr - - associate(tp => self, ntp => self%nbody) - allocate(vdotr(ntp)) - if (param%qmin_coord == "HELIO") then - do i = 1, ntp - vdotr(i) = dot_product(tp%xh(:, i), tp%vh(:, i)) - if (tp%isperi(i) == -1) then - if (vdotr(i) >= 0.0_DP) then - tp%isperi(i) = 0 - call orbel_xv2aeq(tp%mu(i), tp%xh(1,i), tp%xh(2,i), tp%xh(3,i), tp%vh(1,i), tp%vh(2,i), tp%vh(3,i), & - tp%atp(i), e, tp%peri(i)) - end if - else - if (vdotr(i) > 0.0_DP) then - tp%isperi(i) = 1 - else - tp%isperi(i) = -1 - end if - end if - end do - else - do i = 1, ntp - vdotr(i) = dot_product(tp%xb(:, i), tp%vb(:, i)) - if (tp%isperi(i) == -1) then - if (vdotr(i) >= 0.0_DP) then - tp%isperi(i) = 0 - call orbel_xv2aeq(system%Gmtot, tp%xb(1,i), tp%xb(2,i), tp%xb(3,i), tp%vb(1,i), tp%vb(2,i), tp%vb(3,i), & - tp%atp(i), e, tp%peri(i)) - end if - else - if (vdotr(i) > 0.0_DP) then - tp%isperi(i) = 1 - else - tp%isperi(i) = -1 - end if - end if - end do - end if - end associate - - return - end subroutine util_peri_tp - -end submodule s_util_peri diff --git a/src/util/util_rescale.f90 b/src/util/util_rescale.f90 deleted file mode 100644 index 482089859..000000000 --- a/src/util/util_rescale.f90 +++ /dev/null @@ -1,63 +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. - -submodule (swiftest_classes) s_util_rescale - use swiftest -contains - module subroutine util_rescale_system(self, param, mscale, dscale, tscale) - !! author: David A. Minton - !! - !! Rescales an nbody system to a new set of units. Inputs are the multipliers on the mass (mscale), distance (dscale), and time units (tscale). - !! Rescales all united quantities in the system, as well as the mass conversion factors, gravitational constant, and Einstein's constant in the parameter object. - 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. - ! Internals - real(DP) :: vscale - - param%MU2KG = param%MU2KG * mscale - param%DU2M = param%DU2M * dscale - param%TU2S = param%TU2S * tscale - - ! Calculate the G for the system units - param%GU = GC / (param%DU2M**3 / (param%MU2KG * param%TU2S**2)) - - if (param%lgr) then - ! Calculate the inverse speed of light in the system units - param%inv_c2 = einsteinC * param%TU2S / param%DU2M - param%inv_c2 = (param%inv_c2)**(-2) - end if - - vscale = dscale / tscale - - associate(cb => self%cb, pl => self%pl, npl => self%pl%nbody, tp => self%tp, ntp => self%tp%nbody) - - cb%mass = cb%mass / mscale - cb%Gmass = param%GU * cb%mass - cb%radius = cb%radius / dscale - cb%xb(:) = cb%xb(:) / dscale - cb%vb(:) = cb%vb(:) / vscale - cb%rot(:) = cb%rot(:) * tscale - pl%mass(1:npl) = pl%mass(1:npl) / mscale - pl%Gmass(1:npl) = param%GU * pl%mass(1:npl) - pl%radius(1:npl) = pl%radius(1:npl) / dscale - pl%xh(:,1:npl) = pl%xh(:,1:npl) / dscale - pl%vh(:,1:npl) = pl%vh(:,1:npl) / vscale - pl%xb(:,1:npl) = pl%xb(:,1:npl) / dscale - pl%vb(:,1:npl) = pl%vb(:,1:npl) / vscale - pl%rot(:,1:npl) = pl%rot(:,1:npl) * tscale - - end associate - - - return - end subroutine util_rescale_system - -end submodule s_util_rescale \ No newline at end of file diff --git a/src/util/util_resize.f90 b/src/util/util_resize.f90 deleted file mode 100644 index 01cf544ac..000000000 --- a/src/util/util_resize.f90 +++ /dev/null @@ -1,372 +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. - -submodule (swiftest_classes) s_util_resize - use swiftest -contains - - module subroutine util_resize_arr_char_string(arr, nnew) - !! 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 - ! Internals - character(len=STRMAX), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated - integer(I4B) :: nold !! Old size - - if (nnew < 0) return - - if (nnew == 0) then - if (allocated(arr)) deallocate(arr) - return - end if - - if (allocated(arr)) then - nold = size(arr) - else - nold = 0 - end if - - if (nnew == nold) return - - allocate(tmp(nnew)) - if (nold > 0) then - if (nnew > nold) then - tmp(1:nold) = arr(1:nold) - tmp(nold+1:nnew) = "" - else - tmp(1:nnew) = arr(1:nnew) - end if - else - tmp(1:nnew) = "" - end if - call move_alloc(tmp, arr) - - return - end subroutine util_resize_arr_char_string - - - module subroutine util_resize_arr_DP(arr, nnew) - !! 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 - ! Internals - 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 - - if (nnew == 0) then - if (allocated(arr)) deallocate(arr) - return - end if - - if (allocated(arr)) then - nold = size(arr) - else - nold = 0 - end if - - if (nnew == nold) return - - allocate(tmp(nnew)) - if (nold > 0) then - if (nnew > nold) then - tmp(1:nold) = arr(1:nold) - tmp(nold+1:nnew) = init_val - else - tmp(1:nnew) = arr(1:nnew) - end if - else - tmp(1:nnew) = init_val - end if - call move_alloc(tmp, arr) - - return - end subroutine util_resize_arr_DP - - - module subroutine 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. - implicit none - ! Arguments - 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(NDIM), parameter :: init_val = 0.0_DP - integer(I4B) :: i - - if (nnew < 0) return - - if (nnew == 0) then - if (allocated(arr)) deallocate(arr) - return - end if - - if (allocated(arr)) then - nold = size(arr, dim=2) - else - nold = 0 - end if - - if (nnew == nold) return - - allocate(tmp(NDIM, nnew)) - if (nold > 0) then - if (nnew > nold) then - tmp(:,1:nold) = arr(:,1:nold) - do i = nold+1, nnew - tmp(:,i) = init_val(:) - end do - else - tmp(:,1:nnew) = arr(:,1:nnew) - end if - else - do i = 1, nnew - tmp(:, i) = init_val(:) - end do - end if - call move_alloc(tmp, arr) - - return - - return - end subroutine util_resize_arr_DPvec - - - module subroutine util_resize_arr_I4B(arr, nnew) - !! 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 - ! Internals - 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 - - if (nnew == 0) then - if (allocated(arr)) deallocate(arr) - return - end if - - if (allocated(arr)) then - nold = size(arr) - else - nold = 0 - end if - - if (nnew == nold) return - - allocate(tmp(nnew)) - if (nold > 0) then - if (nnew > nold) then - tmp(1:nold) = arr(1:nold) - tmp(nold+1:nnew) = init_val - else - tmp(1:nnew) = arr(1:nnew) - end if - else - tmp(1:nnew) = init_val - end if - call move_alloc(tmp, arr) - - return - end subroutine util_resize_arr_I4B - - - module subroutine util_resize_arr_info(arr, nnew) - !! author: David A. Minton - !! - !! Resizes an array component of type character string. Array will only be resized if has previously been allocated. Passing nnew = 0 will deallocate. - implicit none - ! Arguments - type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size - ! Internals - type(swiftest_particle_info), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated - integer(I4B) :: nold !! Old size - - if (nnew < 0) return - - if (nnew == 0) then - if (allocated(arr)) deallocate(arr) - return - end if - - if (allocated(arr)) then - nold = size(arr) - else - nold = 0 - end if - - if (nnew == nold) return - - allocate(tmp(nnew)) - if (nnew > nold) then - call util_copy_particle_info_arr(arr(1:nold), tmp(1:nold)) - else - call util_copy_particle_info_arr(arr(1:nnew), tmp(1:nnew)) - end if - - call move_alloc(tmp, arr) - - return - end subroutine util_resize_arr_info - - - module subroutine util_resize_arr_logical(arr, nnew) - !! 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 - ! Internals - 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 - - if (nnew == 0) then - if (allocated(arr)) deallocate(arr) - return - end if - - if (allocated(arr)) then - nold = size(arr) - else - nold = 0 - end if - - if (nnew == nold) return - - allocate(tmp(nnew)) - if (nold > 0) then - if (nnew > nold) then - tmp(1:nold) = arr(1:nold) - tmp(nold+1:nnew) = init_val - else - tmp(1:nnew) = arr(1:nnew) - end if - else - tmp(1:nnew) = init_val - end if - call move_alloc(tmp, arr) - - return - end subroutine util_resize_arr_logical - - - module subroutine util_resize_body(self, nnew) - !! author: David A. Minton - !! - !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. - implicit none - ! Arguments - class(swiftest_body), intent(inout) :: self !! Swiftest body object - integer(I4B), intent(in) :: nnew !! New size neded - - call util_resize(self%info, nnew) - call util_resize(self%id, nnew) - call util_resize(self%status, nnew) - call util_resize(self%ldiscard, nnew) - call util_resize(self%lmask, nnew) - call util_resize(self%mu, nnew) - call util_resize(self%xh, nnew) - call util_resize(self%vh, nnew) - call util_resize(self%xb, nnew) - call util_resize(self%vb, nnew) - call util_resize(self%ah, nnew) - call util_resize(self%aobl, nnew) - call util_resize(self%atide, nnew) - call util_resize(self%agr, nnew) - call util_resize(self%ir3h, nnew) - call util_resize(self%a, nnew) - call util_resize(self%e, nnew) - call util_resize(self%inc, nnew) - call util_resize(self%capom, nnew) - call util_resize(self%omega, nnew) - call util_resize(self%capm, nnew) - self%nbody = count(self%status(1:nnew) /= INACTIVE) - - return - end subroutine util_resize_body - - - module subroutine util_resize_pl(self, nnew) - !! author: David A. Minton - !! - !! Checks the current size of a Swiftest massive body against the requested size and resizes it if it is too small. - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - integer(I4B), intent(in) :: nnew !! New size neded - - call util_resize_body(self, nnew) - - call util_resize(self%mass, nnew) - call util_resize(self%Gmass, nnew) - call util_resize(self%rhill, nnew) - call util_resize(self%renc, nnew) - call util_resize(self%radius, nnew) - call util_resize(self%xbeg, nnew) - call util_resize(self%xend, nnew) - call util_resize(self%vbeg, nnew) - call util_resize(self%density, nnew) - call util_resize(self%Ip, nnew) - call util_resize(self%rot, nnew) - call util_resize(self%k2, nnew) - call util_resize(self%Q, nnew) - call util_resize(self%tlag, nnew) - - if (allocated(self%k_plpl)) deallocate(self%k_plpl) - - return - end subroutine util_resize_pl - - - module subroutine util_resize_tp(self, nnew) - !! author: David A. Minton - !! - !! Checks the current size of a Swiftest test particle against the requested size and resizes it if it is too small. - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - integer(I4B), intent(in) :: nnew !! New size neded - - call util_resize_body(self, nnew) - - call util_resize(self%isperi, nnew) - call util_resize(self%peri, nnew) - call util_resize(self%atp, nnew) - - return - end subroutine util_resize_tp - - -end submodule s_util_resize \ No newline at end of file diff --git a/src/util/util_set.f90 b/src/util/util_set.f90 deleted file mode 100644 index 1a67efcbe..000000000 --- a/src/util/util_set.f90 +++ /dev/null @@ -1,251 +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. - -submodule(swiftest_classes) s_util_set - !! author: David A. Minton - !! This submodule contains a collection of setter method implementations - use swiftest -contains - - module subroutine util_set_beg_end_pl(self, xbeg, xend, vbeg) - !! author: David A. Minton - !! - !! Sets one or more of the values of xbeg, xend, and vbeg - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - real(DP), dimension(:,:), intent(in), optional :: xbeg, xend, vbeg - - if (present(xbeg)) then - if (allocated(self%xbeg)) deallocate(self%xbeg) - allocate(self%xbeg, source=xbeg) - end if - if (present(xend)) then - if (allocated(self%xend)) deallocate(self%xend) - allocate(self%xend, source=xend) - end if - if (present(vbeg)) then - if (allocated(self%vbeg)) deallocate(self%vbeg) - allocate(self%vbeg, source=vbeg) - end if - - return - end subroutine util_set_beg_end_pl - - - module subroutine util_set_ir3h(self) - !! author: David A. Minton - !! - !! Sets the inverse heliocentric radius term (1/rh**3) for all bodies in a structure - implicit none - ! Arguments - class(swiftest_body), intent(inout) :: self !! Swiftest generic body object - ! Internals - integer(I4B) :: i - real(DP) :: r2, irh - - if (self%nbody > 0) then - - do i = 1, self%nbody - r2 = dot_product(self%xh(:, i), self%xh(:, i)) - irh = 1.0_DP / sqrt(r2) - self%ir3h(i) = irh / r2 - end do - end if - - return - end subroutine util_set_ir3h - - - module subroutine util_set_msys(self) - !! author: David A. Minton - !! - !! Sets the value of msys and the vector mass quantities based on the total mass of the system - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nobdy system object - - self%Gmtot = self%cb%Gmass + sum(self%pl%Gmass(1:self%pl%nbody), self%pl%status(1:self%pl%nbody) /= INACTIVE) - - return - end subroutine util_set_msys - - - module subroutine util_set_mu_pl(self, cb) - !! author: David A. Minton - !! - !! Computes G * (M + m) for each massive body - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - - if (self%nbody > 0) self%mu(1:self%nbody) = cb%Gmass + self%Gmass(1:self%nbody) - - return - end subroutine util_set_mu_pl - - - module subroutine util_set_mu_tp(self, cb) - !! author: David A. Minton - !! - !! Converts certain scalar values to arrays so that they can be used in elemental functions - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - - if (self%nbody == 0) return - self%mu(1:self%nbody) = cb%Gmass - - return - end subroutine util_set_mu_tp - - module subroutine util_set_particle_info(self, name, particle_type, status, origin_type, origin_time, collision_id, origin_xh,& - origin_vh, discard_time, discard_xh, discard_vh, discard_body_id) - !! author: David A. Minton - !! - !! Sets one or more values of the particle information metadata object - implicit none - ! Arguments - 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_xh !! 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_xh !! 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) - ! Internals - character(len=NAMELEN) :: lenstr - character(len=:), allocatable :: fmtlabel - - write(lenstr, *) NAMELEN - fmtlabel = "(A" // trim(adjustl(lenstr)) // ")" - - if (present(name)) then - write(self%name, fmtlabel) trim(adjustl(name)) - end if - if (present(particle_type)) then - write(self%particle_type, fmtlabel) trim(adjustl(particle_type)) - end if - if (present(status)) then - write(self%status, fmtlabel) trim(adjustl(status)) - end if - if (present(origin_type)) then - write(self%origin_type, fmtlabel) trim(adjustl(origin_type)) - end if - if (present(origin_time)) then - self%origin_time = origin_time - end if - if (present(collision_id)) then - self%collision_id = collision_id - end if - if (present(origin_xh)) then - self%origin_xh(:) = origin_xh(:) - end if - if (present(origin_vh)) then - self%origin_vh(:) = origin_vh(:) - end if - if (present(discard_time)) then - self%discard_time = discard_time - end if - if (present(discard_xh)) then - self%discard_xh(:) = discard_xh(:) - end if - if (present(discard_vh)) then - self%discard_vh(:) = discard_vh(:) - end if - if (present(discard_body_id)) then - self%discard_body_id = discard_body_id - end if - - return - end subroutine util_set_particle_info - - - module subroutine util_set_renc_I4B(self, scale) - !! author: David A. Minton - !! - !! Sets the critical radius for encounter given an input scale factor - !! - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - integer(I4B), intent(in) :: scale !! Input scale factor (multiplier of Hill's sphere size) - - associate(pl => self, npl => self%nbody) - pl%renc(1:npl) = pl%rhill(1:npl) * scale - end associate - - return - end subroutine util_set_renc_I4B - - - module subroutine util_set_renc_DP(self, scale) - !! author: David A. Minton - !! - !! Sets the critical radius for encounter given an input scale factor - !! - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - real(DP), intent(in) :: scale !! Input scale factor (multiplier of Hill's sphere size) - - associate(pl => self, npl => self%nbody) - pl%renc(1:npl) = pl%rhill(1:npl) * scale - end associate - - return - end subroutine util_set_renc_DP - - - module subroutine util_set_rhill(self,cb) - !! author: David A. Minton - !! - !! Sets the value of the Hill's radius - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - - if (self%nbody == 0) return - - call self%xv2el(cb) - self%rhill(1:self%nbody) = self%a(1:self%nbody) * (self%Gmass(1:self%nbody) / cb%Gmass / 3)**THIRD - - return - end subroutine util_set_rhill - - - module subroutine util_set_rhill_approximate(self,cb) - !! author: David A. Minton - !! - !! Sets the approximate value of the Hill's radius using the heliocentric radius instead of computing the semimajor axis - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - ! Internals - real(DP), dimension(:), allocatable :: rh - - if (self%nbody == 0) return - - rh(1:self%nbody) = .mag. self%xh(:,1:self%nbody) - self%rhill(1:self%nbody) = rh(1:self%nbody) * (self%Gmass(1:self%nbody) / cb%Gmass / 3)**THIRD - - return - end subroutine util_set_rhill_approximate - -end submodule s_util_set \ No newline at end of file diff --git a/src/util/util_solve.f90 b/src/util/util_solve.f90 deleted file mode 100644 index 2480eae46..000000000 --- a/src/util/util_solve.f90 +++ /dev/null @@ -1,237 +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. - -submodule(swiftest_classes) s_util_solve - use swiftest -contains - - module function util_solve_linear_system_d(A,b,n,lerr) result(x) - !! Author: David A. Minton - !! - !! Solves the linear equation of the form A*x = b for x. - !! A is an (n,n) arrays - !! x and b are (n) arrays - !! Uses Gaussian elimination, so will have issues if system is ill-conditioned. - !! Uses quad precision intermidiate values, so works best on small arrays. - use, intrinsic :: ieee_exceptions - implicit none - ! Arguments - integer(I4B), intent(in) :: n - real(DP), dimension(:,:), intent(in) :: A - real(DP), dimension(:), intent(in) :: b - logical, intent(out) :: lerr - ! Result - real(DP), dimension(n) :: x - ! Internals - real(QP), dimension(:), allocatable :: qx - type(ieee_status_type) :: original_fpe_status - logical, dimension(:), allocatable :: fpe_flag - - call ieee_get_status(original_fpe_status) ! Save the original floating point exception status - call ieee_set_flag(ieee_all, .false.) ! Set all flags to quiet - allocate(fpe_flag(size(ieee_usual))) - - qx = solve_wbs(ge_wpp(real(A, kind=QP), real(b, kind=QP))) - - call ieee_get_flag(ieee_usual, fpe_flag) - lerr = any(fpe_flag) - if (lerr .or. (any(abs(qx) > huge(x))) .or. (any(abs(qx) < tiny(x)))) then - x = 0.0_DP - else - x = real(qx, kind=DP) - end if - call ieee_set_status(original_fpe_status) - - return - end function util_solve_linear_system_d - - module function util_solve_linear_system_q(A,b,n,lerr) result(x) - !! Author: David A. Minton - !! - !! Solves the linear equation of the form A*x = b for x. - !! A is an (n,n) arrays - !! x and b are (n) arrays - !! Uses Gaussian elimination, so will have issues if system is ill-conditioned. - !! Uses quad precision intermidiate values, so works best on small arrays. - use, intrinsic :: ieee_exceptions - implicit none - ! Arguments - integer(I4B), intent(in) :: n - real(QP), dimension(:,:), intent(in) :: A - real(QP), dimension(:), intent(in) :: b - logical, intent(out) :: lerr - ! Result - real(QP), dimension(n) :: x - ! Internals - type(ieee_status_type) :: original_fpe_status - logical, dimension(:), allocatable :: fpe_flag - - call ieee_get_status(original_fpe_status) ! Save the original floating point exception status - call ieee_set_flag(ieee_all, .false.) ! Set all flags to quiet - allocate(fpe_flag(size(ieee_usual))) - - x = solve_wbs(ge_wpp(A, b)) - - call ieee_get_flag(ieee_usual, fpe_flag) - lerr = any(fpe_flag) - if (lerr) x = 0.0_DP - call ieee_set_status(original_fpe_status) - - return - end function util_solve_linear_system_q - - function solve_wbs(u) result(x) ! solve with backward substitution - !! Based on code available on Rosetta Code: https://rosettacode.org/wiki/Gaussian_elimination#Fortran - use, intrinsic :: ieee_exceptions - use swiftest - implicit none - ! Arguments - real(QP), intent(in), dimension(:,:), allocatable :: u - ! Result - real(QP), dimension(:), allocatable :: x - ! Internals - integer(I4B) :: i,n - - n = size(u, 1) - if (allocated(x)) deallocate(x) - if (.not.allocated(x)) allocate(x(n)) - if (any(abs(u) < tiny(1._DP)) .or. any(abs(u) > huge(1._DP))) then - x(:) = 0._DP - return - end if - call ieee_set_halting_mode(ieee_divide_by_zero, .false.) - do i = n, 1, -1 - x(i) = (u(i, n + 1) - sum(u(i, i + 1:n) * x(i + 1:n))) / u(i, i) - end do - return - end function solve_wbs - - function ge_wpp(A, b) result(u) ! gaussian eliminate with partial pivoting - !! Solve Ax=b using Gaussian elimination then backwards substitution. - !! A being an n by n matrix. - !! x and b are n by 1 vectors. - !! Based on code available on Rosetta Code: https://rosettacode.org/wiki/Gaussian_elimination#Fortran - use, intrinsic :: ieee_exceptions - use swiftest - implicit none - ! Arguments - real(QP), dimension(:,:), intent(in) :: A - real(QP), dimension(:), intent(in) :: b - ! Result - real(QP), dimension(:,:), allocatable :: u - ! Internals - integer(I4B) :: i,j,n,p - real(QP) :: upi - - n = size(a, 1) - allocate(u(n, (n + 1))) - u = reshape([A, b], [n, n + 1]) - call ieee_set_halting_mode(ieee_divide_by_zero, .false.) - do j = 1, n - p = maxloc(abs(u(j:n, j)), 1) + j - 1 ! maxloc returns indices between (1, n - j + 1) - if (p /= j) u([p, j], j) = u([j, p], j) - u(j + 1:, j) = u(j + 1:, j) / u(j, j) - do i = j + 1, n + 1 - upi = u(p, i) - if (p /= j) u([p, j], i) = u([j, p], i) - u(j + 1:n, i) = u(j + 1:n, i) - upi * u(j + 1:n, j) - end do - end do - return - end function ge_wpp - - module function util_solve_rkf45(f, y0in, t1, dt0, tol) result(y1) - !! author: David A. Minton - !! - !! Implements the 4th order Runge-Kutta-Fehlberg ODE solver for initial value problems of the form f=dy/dt, y0 = y(t=0), solving for y1 = y(t=t1). Uses a 5th order adaptive step size control. - !! Uses a lambda function object as defined in the lambda_function module - implicit none - ! Arguments - class(lambda_obj), intent(inout) :: f !! lambda function object that has been initialized to be a function of derivatives. The object will return with components lastarg and lasteval set - real(DP), dimension(:), intent(in) :: y0in !! Initial value at t=0 - real(DP), intent(in) :: t1 !! Final time - real(DP), intent(in) :: dt0 !! Initial step size guess - real(DP), intent(in) :: tol !! Tolerance on solution - ! Result - real(DP), dimension(:), allocatable :: y1 !! Final result - ! Internals - integer(I4B), parameter :: MAXREDUX = 1000 !! Maximum number of times step size can be reduced - real(DP), parameter :: DTFAC = 0.95_DP !! Step size reduction safety factor (Value just under 1.0 to prevent adaptive step size control from discarding steps too aggressively) - integer(I4B), parameter :: RKS = 6 !! Number of RK stages - real(DP), dimension(RKS, RKS - 1), parameter :: rkf45_btab = reshape( & !! Butcher tableau for Runge-Kutta-Fehlberg method - (/ 1./4., 1./4., 0., 0., 0., 0.,& - 3./8., 3./32., 9./32., 0., 0., 0.,& - 12./13., 1932./2197., -7200./2197., 7296./2197., 0., 0.,& - 1., 439./216., -8., 3680./513., -845./4104., 0.,& - 1./2., -8./27., 2., -3544./2565., 1859./4104., -11./40./), shape(rkf45_btab)) - real(DP), dimension(RKS), parameter :: rkf4_coeff = (/ 25./216., 0., 1408./2565. , 2197./4104. , -1./5., 0. /) - real(DP), dimension(RKS), parameter :: rkf5_coeff = (/ 16./135., 0., 6656./12825., 28561./56430., -9./50., 2./55. /) - real(DP), dimension(:, :), allocatable :: k !! Runge-Kutta coefficient vector - real(DP), dimension(:), allocatable :: ynorm !! Normalized y value used for adaptive step size control - real(DP), dimension(:), allocatable :: y0 !! Value of y at the beginning of each substep - integer(I4B) :: Nvar !! Number of variables in problem - integer(I4B) :: rkn !! Runge-Kutta loop index - real(DP) :: t, x1, dt, trem !! Current time, step size and total time remaining - real(DP) :: s, yerr, yscale !! Step size reduction factor, error in dependent variable, and error scale factor - integer(I4B) :: i - - allocate(y0, source=y0in) - allocate(y1, mold=y0) - allocate(ynorm, mold=y0) - Nvar = size(y0) - allocate(k(Nvar, RKS)) - - dt = dt0 - - trem = t1 - t = 0._DP - do - yscale = norm2(y0(:)) - do i = 1, MAXREDUX - select type(f) - class is (lambda_obj_tvar) - do rkn = 1, RKS - y1(:) = y0(:) + matmul(k(:, 1:rkn - 1), rkf45_btab(2:rkn, rkn - 1)) - if (rkn == 1) then - x1 = t - else - x1 = t + rkf45_btab(1,rkn-1) - end if - k(:, rkn) = dt * f%evalt(y1(:), t) - end do - class is (lambda_obj) - do rkn = 1, RKS - y1(:) = y0(:) + matmul(k(:, 1:rkn - 1), rkf45_btab(2:rkn, rkn - 1)) - k(:, rkn) = dt * f%eval(y1(:)) - end do - end select - ! Now determine if the step size needs adjusting - ynorm(:) = matmul(k(:,:), (rkf5_coeff(:) - rkf4_coeff(:))) / yscale - yerr = norm2(ynorm(:)) - s = (tol / (2 * yerr))**(0.25_DP) - dt = min(s * DTFAC * dt, trem) ! Alter step size either up or down, but never bigger than the remaining time - if (s >= 1.0_DP) exit ! Good step! - if (i == MAXREDUX) then - write(*,*) "Something has gone wrong in util_solve_rkf45!! Step size reduction has gone too far this time!" - call util_exit(FAILURE) - end if - end do - - ! Compute new value then step ahead in time - y1(:) = y0(:) + matmul(k(:, :), rkf4_coeff(:)) - trem = trem - dt - t = t + dt - if (trem <= 0._DP) exit - y0(:) = y1(:) - end do - - return - end function util_solve_rkf45 - -end submodule s_util_solve \ No newline at end of file diff --git a/src/util/util_sort.f90 b/src/util/util_sort.f90 deleted file mode 100644 index dde5d7dfe..000000000 --- a/src/util/util_sort.f90 +++ /dev/null @@ -1,1007 +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. - -submodule (swiftest_classes) s_util_sort - use swiftest -contains - - module subroutine util_sort_body(self, sortby, ascending) - !! author: David A. Minton - !! - !! Sort a Swiftest body structure in-place. - !! sortby is a string indicating which array component to sort. - implicit none - ! Arguments - 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 - ! Internals - integer(I4B), dimension(:), allocatable :: ind - integer(I4B) :: direction - - if (self%nbody == 0) return - - if (ascending) then - direction = 1 - else - direction = -1 - end if - - associate(body => self, n => self%nbody) - select case(sortby) - case("id") - call util_sort(direction * body%id(1:n), ind) - case("status") - call util_sort(direction * body%status(1:n), ind) - case("ir3h") - call util_sort(direction * body%ir3h(1:n), ind) - case("a") - call util_sort(direction * body%a(1:n), ind) - case("e") - call util_sort(direction * body%e(1:n), ind) - case("inc") - call util_sort(direction * body%inc(1:n), ind) - case("capom") - call util_sort(direction * body%capom(1:n), ind) - case("mu") - call util_sort(direction * body%mu(1:n), ind) - case("lfirst", "nbody", "ldiscard", "xh", "vh", "xb", "vb", "ah", "aobl", "atide", "agr") - write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' - case default - write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not found!' - return - end select - - call body%rearrange(ind) - - end associate - - return - end subroutine util_sort_body - - - pure module subroutine util_sort_dp(arr) - !! 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 - - call qsort_DP(arr) - - return - end subroutine util_sort_dp - - - pure module subroutine 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 allocates it. - !! - implicit none - ! Arguments - real(DP), dimension(:), intent(in) :: arr - integer(I4B), dimension(:), allocatable, intent(inout) :: ind - ! Internals - integer(I4B) :: n, i - real(DP), dimension(:), allocatable :: tmparr - - n = size(arr) - if (.not.allocated(ind)) then - allocate(ind(n)) - ind = [(i, i=1, n)] - end if - allocate(tmparr, mold=arr) - tmparr(:) = arr(ind(:)) - call qsort_DP(tmparr, ind) - - return - end subroutine util_sort_index_dp - - - recursive pure subroutine qsort_DP(arr, ind) - !! 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 - integer :: iq - - if (size(arr) > 1) then - if (present(ind)) then - call partition_DP(arr, iq, ind) - call qsort_DP(arr(:iq-1),ind(:iq-1)) - call qsort_DP(arr(iq:), ind(iq:)) - else - call partition_DP(arr, iq) - call qsort_DP(arr(:iq-1)) - call qsort_DP(arr(iq:)) - end if - end if - - return - end subroutine qsort_DP - - - pure subroutine partition_DP(arr, marker, ind) - !! author: David A. Minton - !! - !! Partition function for quicksort on DP type - !! - implicit none - ! Arguments - real(DP), intent(inout), dimension(:) :: arr - integer(I4B), intent(inout), dimension(:), optional :: ind - integer(I4B), intent(out) :: marker - ! Internals - integer(I4B) :: i, j, itmp, narr, ipiv - real(DP) :: temp - real(DP) :: x ! pivot point - - narr = size(arr) - - ! Get center as pivot, as this is likely partially sorted - ipiv = narr / 2 - x = arr(ipiv) - i = 0 - j = narr + 1 - - do - j = j - 1 - do - if (arr(j) <= x) exit - j = j - 1 - end do - i = i + 1 - do - if (arr(i) >= x) exit - i = i + 1 - end do - if (i < j) then - ! exchange A(i) and A(j) - temp = arr(i) - arr(i) = arr(j) - arr(j) = temp - if (present(ind)) then - itmp = ind(i) - ind(i) = ind(j) - ind(j) = itmp - end if - else if (i == j) then - marker = i + 1 - return - else - marker = i - return - endif - end do - - return - end subroutine partition_DP - - - pure module subroutine 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) - !! - implicit none - ! Arguments - integer(I4B), dimension(:), intent(inout) :: arr - - call qsort_I4B(arr) - - return - end subroutine util_sort_i4b - - - pure module subroutine 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 allocates it. - !! - implicit none - ! Arguments - integer(I4B), dimension(:), intent(in) :: arr - integer(I4B), dimension(:), allocatable, intent(inout) :: ind - ! Internals - integer(I4B) :: n, i - integer(I4B), dimension(:), allocatable :: tmparr - - n = size(arr) - if (.not.allocated(ind)) then - allocate(ind(n)) - ind = [(i, i=1, n)] - end if - allocate(tmparr, mold=arr) - tmparr(:) = arr(ind(:)) - call qsort_I4B(tmparr, ind) - - return - end subroutine util_sort_index_I4B - - - pure module subroutine 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 allocates it. - !! - implicit none - ! Arguments - integer(I4B), dimension(:), intent(in) :: arr - integer(I8B), dimension(:), allocatable, intent(inout) :: ind - ! Internals - integer(I8B) :: n, i - integer(I4B), dimension(:), allocatable :: tmparr - - n = size(arr) - if (.not.allocated(ind)) then - allocate(ind(n)) - ind = [(i, i=1_I8B, n)] - end if - allocate(tmparr, mold=arr) - tmparr(:) = arr(ind(:)) - call qsort_I4B_I8Bind(tmparr, ind) - - return - end subroutine util_sort_index_I4B_I8Bind - - - recursive pure subroutine qsort_I4B(arr, ind) - !! 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 - integer(I4B), dimension(:), intent(out), optional :: ind - ! Internals - integer(I4B) :: iq - - if (size(arr) > 1) then - if (present(ind)) then - call partition_I4B(arr, iq, ind) - call qsort_I4B(arr(:iq-1),ind(:iq-1)) - call qsort_I4B(arr(iq:), ind(iq:)) - else - call partition_I4B(arr, iq) - call qsort_I4B(arr(:iq-1)) - call qsort_I4B(arr(iq:)) - end if - end if - - return - end subroutine qsort_I4B - - recursive pure subroutine qsort_I4B_I8Bind(arr, ind) - !! 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 - integer(I8B), dimension(:), intent(out), optional :: ind - ! Internals - integer(I8B) :: iq - - if (size(arr) > 1_I8B) then - if (present(ind)) then - call partition_I4B_I8Bind(arr, iq, ind) - call qsort_I4B_I8Bind(arr(:iq-1_I8B),ind(:iq-1_I8B)) - call qsort_I4B_I8Bind(arr(iq:), ind(iq:)) - else - call partition_I4B_I8Bind(arr, iq) - call qsort_I4B_I8Bind(arr(:iq-1_I8B)) - call qsort_I4B_I8Bind(arr(iq:)) - end if - end if - - return - end subroutine qsort_I4B_I8Bind - - - recursive pure subroutine qsort_I8B_I8Bind(arr, ind) - !! 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 - integer(I8B), dimension(:), intent(out), optional :: ind - ! Internals - integer(I8B) :: iq - - if (size(arr) > 1_I8B) then - if (present(ind)) then - call partition_I8B_I8Bind(arr, iq, ind) - call qsort_I8B_I8Bind(arr(:iq-1_I8B),ind(:iq-1_I8B)) - call qsort_I8B_I8Bind(arr(iq:), ind(iq:)) - else - call partition_I8B_I8Bind(arr, iq) - call qsort_I8B_I8Bind(arr(:iq-1_I8B)) - call qsort_I8B_I8Bind(arr(iq:)) - end if - end if - - return - end subroutine qsort_I8B_I8Bind - - - pure subroutine partition_I4B(arr, marker, ind) - !! author: David A. Minton - !! - !! Partition function for quicksort on I4B type - !! - implicit none - ! Arguments - integer(I4B), intent(inout), dimension(:) :: arr - integer(I4B), intent(inout), dimension(:), optional :: ind - integer(I4B), intent(out) :: marker - ! Internals - integer(I4B) :: i, j, itmp, narr, ipiv - integer(I4B) :: temp - integer(I4B) :: x ! pivot point - - narr = size(arr) - - ! Get center as pivot, as this is likely partially sorted - ipiv = narr / 2 - x = arr(ipiv) - i = 0 - j = narr + 1 - - do - j = j - 1 - do - if (arr(j) <= x) exit - j = j - 1 - end do - i = i + 1 - do - if (arr(i) >= x) exit - i = i + 1 - end do - if (i < j) then - ! exchange A(i) and A(j) - temp = arr(i) - arr(i) = arr(j) - arr(j) = temp - if (present(ind)) then - itmp = ind(i) - ind(i) = ind(j) - ind(j) = itmp - end if - else if (i == j) then - marker = i + 1 - return - else - marker = i - return - endif - end do - - return - end subroutine partition_I4B - - pure subroutine partition_I4B_I8Bind(arr, marker, ind) - !! author: David A. Minton - !! - !! Partition function for quicksort on I4B type - !! - implicit none - ! Arguments - integer(I4B), intent(inout), dimension(:) :: arr - integer(I8B), intent(inout), dimension(:), optional :: ind - integer(I8B), intent(out) :: marker - ! Internals - integer(I8B) :: i, j, itmp, narr, ipiv - integer(I4B) :: temp - integer(I8B) :: x ! pivot point - - narr = size(arr) - - ! Get center as pivot, as this is likely partially sorted - ipiv = narr / 2_I8B - x = arr(ipiv) - i = 0_I8B - j = narr + 1_I8B - - do - j = j - 1_I8B - do - if (arr(j) <= x) exit - j = j - 1_I8B - end do - i = i + 1_I8B - do - if (arr(i) >= x) exit - i = i + 1_I8B - end do - if (i < j) then - ! exchange A(i) and A(j) - temp = arr(i) - arr(i) = arr(j) - arr(j) = temp - if (present(ind)) then - itmp = ind(i) - ind(i) = ind(j) - ind(j) = itmp - end if - else if (i == j) then - marker = i + 1_I8B - return - else - marker = i - return - endif - end do - - return - end subroutine partition_I4B_I8Bind - - pure subroutine partition_I8B_I8Bind(arr, marker, ind) - !! author: David A. Minton - !! - !! Partition function for quicksort on I8B type with I8B index - !! - implicit none - ! Arguments - integer(I8B), intent(inout), dimension(:) :: arr - integer(I8B), intent(inout), dimension(:), optional :: ind - integer(I8B), intent(out) :: marker - ! Internals - integer(I8B) :: i, j, itmp, narr, ipiv - integer(I8B) :: temp - integer(I8B) :: x ! pivot point - - narr = size(arr) - - ! Get center as pivot, as this is likely partially sorted - ipiv = narr / 2_I8B - x = arr(ipiv) - i = 0_I8B - j = narr + 1_I8B - - do - j = j - 1_I8B - do - if (arr(j) <= x) exit - j = j - 1_I8B - end do - i = i + 1_I8B - do - if (arr(i) >= x) exit - i = i + 1_I8B - end do - if (i < j) then - ! exchange A(i) and A(j) - temp = arr(i) - arr(i) = arr(j) - arr(j) = temp - if (present(ind)) then - itmp = ind(i) - ind(i) = ind(j) - ind(j) = itmp - end if - else if (i == j) then - marker = i + 1_I8B - return - else - marker = i - return - endif - end do - - return - end subroutine partition_I8B_I8Bind - - - pure module subroutine util_sort_sp(arr) - !! 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 - - call qsort_SP(arr) - - return - end subroutine util_sort_sp - - - pure module subroutine 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 allocates it. - !! - implicit none - ! Arguments - real(SP), dimension(:), intent(in) :: arr - integer(I4B), dimension(:), allocatable, intent(inout) :: ind - ! Internals - integer(I4B) :: n, i - real(SP), dimension(:), allocatable :: tmparr - - n = size(arr) - if (.not.allocated(ind)) then - allocate(ind(n)) - ind = [(i, i=1, n)] - end if - allocate(tmparr, mold=arr) - tmparr(:) = arr(ind(:)) - call qsort_SP(tmparr, ind) - - return - end subroutine util_sort_index_sp - - - recursive pure subroutine qsort_SP(arr, ind) - !! 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 - integer :: iq - - if (size(arr) > 1) then - if (present(ind)) then - call partition_SP(arr, iq, ind) - call qsort_SP(arr(:iq-1),ind(:iq-1)) - call qsort_SP(arr(iq:), ind(iq:)) - else - call partition_SP(arr, iq) - call qsort_SP(arr(:iq-1)) - call qsort_SP(arr(iq:)) - end if - end if - - return - end subroutine qsort_SP - - - pure subroutine partition_SP(arr, marker, ind) - !! author: David A. Minton - !! - !! Partition function for quicksort on SP type - !! - implicit none - ! Arguments - real(SP), intent(inout), dimension(:) :: arr - integer(I4B), intent(inout), dimension(:), optional :: ind - integer(I4B), intent(out) :: marker - ! Internals - integer(I4B) :: i, j, itmp, narr, ipiv - real(SP) :: temp - real(SP) :: x ! pivot point - - narr = size(arr) - - ! Get center as pivot, as this is likely partially sorted - ipiv = narr / 2 - x = arr(ipiv) - i = 0 - j = narr + 1 - - do - j = j - 1 - do - if (arr(j) <= x) exit - j = j - 1 - end do - i = i + 1 - do - if (arr(i) >= x) exit - i = i + 1 - end do - if (i < j) then - ! exchange A(i) and A(j) - temp = arr(i) - arr(i) = arr(j) - arr(j) = temp - if (present(ind)) then - itmp = ind(i) - ind(i) = ind(j) - ind(j) = itmp - end if - else if (i == j) then - marker = i + 1 - return - else - marker = i - return - endif - end do - - return - end subroutine partition_SP - - - module subroutine util_sort_pl(self, sortby, ascending) - !! author: David A. Minton - !! - !! Sort a Swiftest massive body object in-place. - !! sortby is a string indicating which array component to sort. - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest 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 - - if (self%nbody == 0) return - - if (ascending) then - direction = 1 - else - direction = -1 - end if - - associate(pl => self, npl => self%nbody) - select case(sortby) - case("Gmass","mass") - call util_sort(direction * pl%Gmass(1:npl), ind) - case("rhill") - call util_sort(direction * pl%rhill(1:npl), ind) - case("renc") - call util_sort(direction * pl%renc(1:npl), ind) - case("radius") - call util_sort(direction * pl%radius(1:npl), ind) - case("density") - call util_sort(direction * pl%density(1:npl), ind) - case("k2") - call util_sort(direction * pl%k2(1:npl), ind) - case("Q") - call util_sort(direction * pl%Q(1:npl), ind) - case("tlag") - call util_sort(direction * pl%tlag(1:npl), ind) - case("xbeg", "xend", "vbeg", "Ip", "rot", "k_plpl", "nplpl") - write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' - case default ! Look for components in the parent class - call util_sort_body(pl, sortby, ascending) - return - end select - - call pl%rearrange(ind) - - end associate - - return - end subroutine util_sort_pl - - - module subroutine util_sort_tp(self, sortby, ascending) - !! author: David A. Minton - !! - !! Sort a Swiftest test particle object in-place. - !! sortby is a string indicating which array component to sort. - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest 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 - - if (self%nbody == 0) return - - if (ascending) then - direction = 1 - else - direction = -1 - end if - - associate(tp => self, ntp => self%nbody) - select case(sortby) - case("peri") - call util_sort(direction * tp%peri(1:ntp), ind) - case("atp") - call util_sort(direction * tp%atp(1:ntp), ind) - case("isperi") - write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' - case default ! Look for components in the parent class - call util_sort_body(tp, sortby, ascending) - return - end select - - call tp%rearrange(ind) - - end associate - - return - end subroutine util_sort_tp - - - module subroutine util_sort_rearrange_body(self, ind) - !! author: David A. Minton - !! - !! Rearrange Swiftest body structure in-place from an index list. - !! This is a helper utility used to make polymorphic sorting work on Swiftest structures. - implicit none - ! Arguments - 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) - - associate(n => self%nbody) - call util_sort_rearrange(self%id, ind, n) - call util_sort_rearrange(self%info, ind, n) - call util_sort_rearrange(self%status, ind, n) - call util_sort_rearrange(self%ldiscard, ind, n) - call util_sort_rearrange(self%xh, ind, n) - call util_sort_rearrange(self%vh, ind, n) - call util_sort_rearrange(self%xb, ind, n) - call util_sort_rearrange(self%vb, ind, n) - call util_sort_rearrange(self%ah, ind, n) - call util_sort_rearrange(self%ir3h, ind, n) - call util_sort_rearrange(self%mu, ind, n) - call util_sort_rearrange(self%lmask, ind, n) - call util_sort_rearrange(self%a, ind, n) - call util_sort_rearrange(self%e, ind, n) - call util_sort_rearrange(self%inc, ind, n) - call util_sort_rearrange(self%capom, ind, n) - call util_sort_rearrange(self%omega, ind, n) - call util_sort_rearrange(self%capm, ind, n) - call util_sort_rearrange(self%aobl, ind, n) - call util_sort_rearrange(self%atide, ind, n) - call util_sort_rearrange(self%agr, ind, n) - end associate - - return - end subroutine util_sort_rearrange_body - - - pure module subroutine 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. - 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 - ! Internals - 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) - tmp(1:n) = arr(ind) - call move_alloc(tmp, arr) - - return - end subroutine util_sort_rearrange_arr_char_string - - - pure module subroutine 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. - 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 - ! Internals - 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) - tmp(1:n) = arr(ind) - call move_alloc(tmp, arr) - - return - end subroutine util_sort_rearrange_arr_DP - - - pure module subroutine 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. - 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 - ! Internals - 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) - tmp(:,1:n) = arr(:, ind) - call move_alloc(tmp, arr) - - return - end subroutine util_sort_rearrange_arr_DPvec - - - pure module subroutine util_sort_rearrange_arr_I4B(arr, ind, n) - !! 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 - ! Internals - 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) - tmp(1:n) = arr(ind) - call move_alloc(tmp, arr) - - return - end subroutine util_sort_rearrange_arr_I4B - - pure module subroutine 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. - 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 - ! Internals - 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) - tmp(1:n) = arr(ind) - call move_alloc(tmp, arr) - - return - end subroutine util_sort_rearrange_arr_I4B_I8Bind - - - pure module subroutine util_sort_rearrange_arr_logical(arr, ind, n) - !! 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 - ! Internals - logical, dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation - - if (.not. allocated(arr) .or. n <= 0) return - allocate(tmp, mold=arr) - tmp(1:n) = arr(ind) - call move_alloc(tmp, arr) - - return - end subroutine util_sort_rearrange_arr_logical - - - pure module subroutine 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. - 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 - ! Internals - logical, dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation - - if (.not. allocated(arr) .or. n <= 0) return - allocate(tmp, mold=arr) - tmp(1:n) = arr(ind) - call move_alloc(tmp, arr) - - return - end subroutine util_sort_rearrange_arr_logical_I8Bind - - - module subroutine util_sort_rearrange_arr_info(arr, ind, n) - !! author: David A. Minton - !! - !! Rearrange a single array of particle information type in-place from an index list. - implicit none - ! Arguments - 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 - ! Internals - type(swiftest_particle_info), dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation - - if (.not. allocated(arr) .or. n <= 0) return - allocate(tmp, mold=arr) - - call util_copy_particle_info_arr(arr, tmp, ind) - call move_alloc(tmp, arr) - - return - end subroutine util_sort_rearrange_arr_info - - - module subroutine util_sort_rearrange_pl(self, ind) - !! author: David A. Minton - !! - !! Rearrange Swiftest massive body structure in-place from an index list. - !! This is a helper utility used to make polymorphic sorting work on Swiftest structures. - 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) - - associate(pl => self, npl => self%nbody) - call util_sort_rearrange(pl%mass, ind, npl) - call util_sort_rearrange(pl%Gmass, ind, npl) - call util_sort_rearrange(pl%rhill, ind, npl) - call util_sort_rearrange(pl%xbeg, ind, npl) - call util_sort_rearrange(pl%vbeg, ind, npl) - call util_sort_rearrange(pl%radius, ind, npl) - call util_sort_rearrange(pl%density, ind, npl) - call util_sort_rearrange(pl%Ip, ind, npl) - call util_sort_rearrange(pl%rot, ind, npl) - call util_sort_rearrange(pl%k2, ind, npl) - call util_sort_rearrange(pl%Q, ind, npl) - call util_sort_rearrange(pl%tlag, ind, npl) - - if (allocated(pl%k_plpl)) deallocate(pl%k_plpl) - - call util_sort_rearrange_body(pl, ind) - end associate - - return - end subroutine util_sort_rearrange_pl - - - module subroutine util_sort_rearrange_tp(self, ind) - !! author: David A. Minton - !! - !! Rearrange Swiftest massive body structure in-place from an index list. - !! This is a helper utility used to make polymorphic sorting work on Swiftest structures. - implicit none - ! Arguments - 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) - - associate(tp => self, ntp => self%nbody) - call util_sort_rearrange(tp%isperi, ind, ntp) - call util_sort_rearrange(tp%peri, ind, ntp) - call util_sort_rearrange(tp%atp, ind, ntp) - - call util_sort_rearrange_body(tp, ind) - end associate - - return - end subroutine util_sort_rearrange_tp - -end submodule s_util_sort diff --git a/src/util/util_spill.f90 b/src/util/util_spill.f90 deleted file mode 100644 index 63d7fe1d9..000000000 --- a/src/util/util_spill.f90 +++ /dev/null @@ -1,440 +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. - -submodule (swiftest_classes) s_util_spill - use swiftest -contains - - module subroutine 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 - 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 - ! Internals - integer(I4B) :: nspill, nkeep, nlist - character(len=STRMAX), dimension(:), allocatable :: tmp !! Array of values to keep - - nkeep = count(.not.lspill_list(:)) - nspill = count(lspill_list(:)) - nlist = size(lspill_list(:)) - - if (.not.allocated(keeps) .or. nspill == 0) return - if (.not.allocated(discards)) then - allocate(discards(nspill)) - else if (size(discards) /= nspill) then - deallocate(discards) - allocate(discards(nspill)) - end if - - discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) - if (ldestructive) then - if (nkeep > 0) then - allocate(tmp(nkeep)) - tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) - call move_alloc(tmp, keeps) - else - deallocate(keeps) - end if - end if - - return - end subroutine util_spill_arr_char_string - - - module subroutine 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 - 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 - ! Internals - integer(I4B) :: nspill, nkeep, nlist - real(DP), dimension(:), allocatable :: tmp !! Array of values to keep - - nkeep = count(.not.lspill_list(:)) - nspill = count(lspill_list(:)) - nlist = size(lspill_list(:)) - - if (.not.allocated(keeps) .or. nspill == 0) return - if (.not.allocated(discards)) then - allocate(discards(nspill)) - else if (size(discards) /= nspill) then - deallocate(discards) - allocate(discards(nspill)) - end if - - discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) - if (ldestructive) then - if (nkeep > 0) then - allocate(tmp(nkeep)) - tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) - call move_alloc(tmp, keeps) - else - deallocate(keeps) - end if - end if - - return - end subroutine util_spill_arr_DP - - - module subroutine 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 - 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 - ! Internals - integer(I4B) :: i, nspill, nkeep, nlist - real(DP), dimension(:,:), allocatable :: tmp !! Array of values to keep - - nkeep = count(.not.lspill_list(:)) - nspill = count(lspill_list(:)) - nlist = size(lspill_list(:)) - - if (.not.allocated(keeps) .or. nspill == 0) return - if (.not.allocated(discards)) then - allocate(discards(NDIM, nspill)) - else if (size(discards, dim=2) /= nspill) then - deallocate(discards) - allocate(discards(NDIM, nspill)) - end if - - do i = 1, NDIM - discards(i,:) = pack(keeps(i,1:nlist), lspill_list(1:nlist)) - end do - if (ldestructive) then - if (nkeep > 0) then - allocate(tmp(NDIM, nkeep)) - do i = 1, NDIM - tmp(i, :) = pack(keeps(i, 1:nlist), .not. lspill_list(1:nlist)) - end do - call move_alloc(tmp, keeps) - else - deallocate(keeps) - end if - end if - - return - end subroutine util_spill_arr_DPvec - - - module subroutine 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 - 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 - ! Internals - integer(I4B) :: nspill, nkeep, nlist - integer(I4B), dimension(:), allocatable :: tmp !! Array of values to keep - - nkeep = count(.not.lspill_list(:)) - nspill = count(lspill_list(:)) - nlist = size(lspill_list(:)) - - if (.not.allocated(keeps) .or. nspill == 0) return - if (.not.allocated(discards)) then - allocate(discards(nspill)) - else if (size(discards) /= nspill) then - deallocate(discards) - allocate(discards(nspill)) - end if - - discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) - if (ldestructive) then - if (nkeep > 0) then - allocate(tmp(nkeep)) - tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) - call move_alloc(tmp, keeps) - else - deallocate(keeps) - end if - end if - - return - end subroutine util_spill_arr_I4B - - - module subroutine 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 - 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 - ! Internals - integer(I4B) :: nspill, nkeep, nlist - integer(I8B), dimension(:), allocatable :: tmp !! Array of values to keep - - nkeep = count(.not.lspill_list(:)) - nspill = count(lspill_list(:)) - nlist = size(lspill_list(:)) - - if (.not.allocated(keeps) .or. nspill == 0) return - if (.not.allocated(discards)) then - allocate(discards(nspill)) - else if (size(discards) /= nspill) then - deallocate(discards) - allocate(discards(nspill)) - end if - - discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) - if (ldestructive) then - if (nkeep > 0) then - allocate(tmp(nkeep)) - tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) - call move_alloc(tmp, keeps) - else - deallocate(keeps) - end if - end if - - return - end subroutine util_spill_arr_I8B - - - module subroutine util_spill_arr_info(keeps, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Performs a spill operation on a single array of particle origin information types - !! This is the inverse of a spill operation - implicit none - ! Arguments - 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 - ! Internals - integer(I4B) :: i, nspill, nkeep, nlist - integer(I4B), dimension(:), allocatable :: idx - type(swiftest_particle_info), dimension(:), allocatable :: tmp - - nkeep = count(.not.lspill_list(:)) - nspill = count(lspill_list(:)) - nlist = size(lspill_list(:)) - - if (.not.allocated(keeps) .or. nspill == 0) return - if (.not.allocated(discards)) then - allocate(discards(nspill)) - else if (size(discards) /= nspill) then - deallocate(discards) - allocate(discards(nspill)) - end if - - allocate(idx(nspill)) - idx(:) = pack([(i, i = 1, nlist)], lspill_list) - call util_copy_particle_info_arr(keeps, discards, idx) - if (ldestructive) then - if (nkeep > 0) then - deallocate(idx) - allocate(idx(nkeep)) - allocate(tmp(nkeep)) - idx(:) = pack([(i, i = 1, nlist)], .not. lspill_list) - call util_copy_particle_info_arr(keeps, tmp, idx) - call move_alloc(tmp, keeps) - else - deallocate(keeps) - end if - end if - - return - end subroutine util_spill_arr_info - - - module subroutine 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 - 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 - ! Internals - integer(I4B) :: nspill, nkeep, nlist - logical, dimension(:), allocatable :: tmp !! Array of values to keep - - nkeep = count(.not.lspill_list(:)) - nspill = count(lspill_list(:)) - nlist = size(lspill_list(:)) - - if (.not.allocated(keeps) .or. nspill == 0) return - if (.not.allocated(discards)) then - allocate(discards(nspill)) - else if (size(discards) /= nspill) then - deallocate(discards) - allocate(discards(nspill)) - end if - - discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) - if (ldestructive) then - if (nkeep > 0) then - allocate(tmp(nkeep)) - tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) - call move_alloc(tmp, keeps) - else - deallocate(keeps) - end if - end if - - return - end subroutine util_spill_arr_logical - - - module subroutine util_spill_body(self, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Move spilled (discarded) Swiftest generic particle structure from active list to discard list - !! Adapted from David E. Kaufmann's Swifter routine whm_discard_spill.f90 - implicit none - ! Arguments - class(swiftest_body), intent(inout) :: self !! Swiftest generic 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 - ! Internals - integer(I4B) :: nbody_old - - ! 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) - - call util_spill(keeps%id, discards%id, lspill_list, ldestructive) - call util_spill(keeps%info, discards%info, lspill_list, ldestructive) - call util_spill(keeps%status, discards%status, lspill_list, ldestructive) - call util_spill(keeps%lmask, discards%lmask, lspill_list, ldestructive) - call util_spill(keeps%ldiscard, discards%ldiscard, lspill_list, ldestructive) - call util_spill(keeps%mu, discards%mu, lspill_list, ldestructive) - call util_spill(keeps%xh, discards%xh, lspill_list, ldestructive) - call util_spill(keeps%vh, discards%vh, lspill_list, ldestructive) - call util_spill(keeps%xb, discards%xb, lspill_list, ldestructive) - call util_spill(keeps%vb, discards%vb, lspill_list, ldestructive) - call util_spill(keeps%ah, discards%ah, lspill_list, ldestructive) - call util_spill(keeps%aobl, discards%aobl, lspill_list, ldestructive) - call util_spill(keeps%agr, discards%agr, lspill_list, ldestructive) - call util_spill(keeps%atide, discards%atide, lspill_list, ldestructive) - call util_spill(keeps%a, discards%a, lspill_list, ldestructive) - call util_spill(keeps%e, discards%e, lspill_list, ldestructive) - call util_spill(keeps%inc, discards%inc, lspill_list, ldestructive) - call util_spill(keeps%capom, discards%capom, lspill_list, ldestructive) - call util_spill(keeps%omega, discards%omega, lspill_list, ldestructive) - call util_spill(keeps%capm, discards%capm, lspill_list, ldestructive) - - nbody_old = keeps%nbody - - ! This is the base class, so will be the last to be called in the cascade. - ! Therefore we need to set the nbody values for both the keeps and discareds - discards%nbody = count(lspill_list(1:nbody_old)) - if (ldestructive) keeps%nbody = nbody_old- discards%nbody - end associate - - return - end subroutine util_spill_body - - - module subroutine util_spill_pl(self, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Move spilled (discarded) Swiftest massive body structure from active list to discard list - !! Adapted from David E. Kaufmann's Swifter routine whm_discard_spill.f90 - implicit none - ! Arguments - 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 body by removing the discard list - - associate(keeps => self) - select type (discards) ! The standard requires us to select the type of both arguments in order to access all the components - class is (swiftest_pl) - !> Spill components specific to the massive body class - call util_spill(keeps%mass, discards%mass, lspill_list, ldestructive) - call util_spill(keeps%Gmass, discards%Gmass, lspill_list, ldestructive) - call util_spill(keeps%rhill, discards%rhill, lspill_list, ldestructive) - call util_spill(keeps%renc, discards%renc, lspill_list, ldestructive) - call util_spill(keeps%radius, discards%radius, lspill_list, ldestructive) - call util_spill(keeps%density, discards%density, lspill_list, ldestructive) - call util_spill(keeps%k2, discards%k2, lspill_list, ldestructive) - call util_spill(keeps%Q, discards%Q, lspill_list, ldestructive) - call util_spill(keeps%tlag, discards%tlag, lspill_list, ldestructive) - call util_spill(keeps%xbeg, discards%xbeg, lspill_list, ldestructive) - call util_spill(keeps%vbeg, discards%vbeg, lspill_list, ldestructive) - call util_spill(keeps%Ip, discards%Ip, lspill_list, ldestructive) - call util_spill(keeps%rot, discards%rot, lspill_list, ldestructive) - - if (ldestructive .and. allocated(keeps%k_plpl)) deallocate(keeps%k_plpl) - - call util_spill_body(keeps, discards, lspill_list, ldestructive) - class default - write(*,*) 'Error! spill method called for incompatible return type on swiftest_pl' - end select - end associate - - return - end subroutine util_spill_pl - - - module subroutine util_spill_tp(self, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Move spilled (discarded) Swiftest test particle structure from active list to discard list - !! Adapted from David E. Kaufmann's Swifter routine whm_discard_spill.f90 - implicit none - ! Arguments - 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 discardse - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter body by removing the discard list - - associate(keeps => self, ntp => self%nbody) - select type(discards) - class is (swiftest_tp) - !> Spill components specific to the test particle class - call util_spill(keeps%isperi, discards%isperi, lspill_list, ldestructive) - call util_spill(keeps%peri, discards%peri, lspill_list, ldestructive) - call util_spill(keeps%atp, discards%atp, lspill_list, ldestructive) - - call util_spill_body(keeps, discards, lspill_list, ldestructive) - class default - write(*,*) 'Error! spill method called for incompatible return type on swiftest_tp' - end select - end associate - - return - end subroutine util_spill_tp - -end submodule s_util_spill \ No newline at end of file diff --git a/src/util/util_valid.f90 b/src/util/util_valid.f90 deleted file mode 100644 index e6a4b6663..000000000 --- a/src/util/util_valid.f90 +++ /dev/null @@ -1,52 +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. - -submodule (swiftest_classes) s_util_valid - use swiftest -contains - - module subroutine util_valid_id_system(self, param) - !! author: David A. Minton - !! - !! Validate massive body and test particle ids - !! Subroutine causes program to exit with error if any ids are not unique - !! - !! Adapted from David E. Kaufmann's Swifter routine: util_valid.f90 - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i - integer(I4B), dimension(:), allocatable :: idarr - - associate(cb => self%cb, pl => self%pl, npl => self%pl%nbody, tp => self%tp, ntp => self%tp%nbody) - allocate(idarr(1+npl+ntp)) - idarr(1) = cb%id - do i = 1, npl - idarr(1+i) = pl%id(i) - end do - do i = 1, ntp - idarr(1+npl+i) = tp%id(i) - end do - call util_sort(idarr) - do i = 1, npl + ntp - if (idarr(i) == idarr(i+1)) then - write(*, *) "Swiftest error:" - write(*, *) " more than one body/particle has id = ", idarr(i) - call util_exit(FAILURE) - end if - end do - param%maxid = max(param%maxid, maxval(idarr)) - end associate - - return - end subroutine util_valid_id_system - -end submodule s_util_valid diff --git a/src/util/util_version.f90 b/src/util/util_version.f90 deleted file mode 100644 index f44062e5e..000000000 --- a/src/util/util_version.f90 +++ /dev/null @@ -1,62 +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. - -submodule (swiftest_classes) s_util_version - use swiftest -contains - - module subroutine util_version() - !! author: David A. Minton - !! - !! Print program version information to terminale - !! - !! Adapted from David E. Kaufmann's Swifter routine: util_version.f90 - implicit none - write(*, 200) VERSION_NUMBER -200 format(/, "************* Swiftest: Version ", f3.1, " *************", //, & - "Based off of Swifter:", //, & - "Authors:", //, & - " The Purdue University Swiftest Development team ", /, & - " Lead by David A. Minton ", /, & - " Single loop blocking by Jacob R. Elliott", /, & - " Fragmentation by Carlisle A. Wishard and", //, & - " Jennifer L. L. Poutplin ", //, & - "Please address comments and questions to:", //, & - " David A. Minton", /, & - " Department Earth, Atmospheric, & Planetary Sciences ",/, & - " Purdue University", /, & - " 550 Stadium Mall Drive", /, & - " West Lafayette, Indiana 47907", /, & - " 765-250-8034 ", /, & - " daminton@purdue.edu", /, & - "Special thanks to Hal Levison and Martin Duncan for the original",/,& - "SWIFTER and SWIFT codes that made this possible.", //, & - "************************************************", /) - - - 100 FORMAT(/, "************* SWIFTER: Version ", F3.1, " *************", //, & - "Authors:", //, & - " Martin Duncan: Queen's University", /, & - " Hal Levison : Southwest Research Institute", //, & - "Please address comments and questions to:", //, & - " Hal Levison or David Kaufmann", /, & - " Department of Space Studies", /, & - " Southwest Research Institute", /, & - " 1050 Walnut Street, Suite 400", /, & - " Boulder, Colorado 80302", /, & - " 303-546-0290 (HFL), 720-240-0119 (DEK)", /, & - " 303-546-9687 (fax)", /, & - " hal@gort.boulder.swri.edu (HFL)", /, & - " kaufmann@boulder.swri.edu (DEK)", //, & - "************************************************", /) - - return - end subroutine util_version - -end submodule s_util_version diff --git a/src/walltime/walltime.f90 b/src/walltime/walltime.f90 deleted file mode 100644 index 6c53e2276..000000000 --- a/src/walltime/walltime.f90 +++ /dev/null @@ -1,355 +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. - -submodule(walltime_classes) s_walltime - use swiftest -contains - - module subroutine walltime_stop(self) - !! author: David A. Minton - !! - !! Pauses the step timer (but not the main timer). - implicit none - ! Arguments - class(walltimer), intent(inout) :: self !! Walltimer object - ! Internals - integer(I8B) :: count_delta - - if (self%is_paused) then - write(*,*) "Wall timer error: Timer is already paused!" - return - end if - - call system_clock(self%count_pause) - self%is_paused = .true. - - self%count_stop_step = self%count_pause - - count_delta = self%count_stop_step - self%count_start_step - self%wall_step = count_delta / (self%count_rate * 1.0_DP) - - return - end subroutine walltime_stop - - - module subroutine walltime_report(self, message, nsubsteps) - !! author: David A. Minton - !! - !! Prints the elapsed time information to the terminal - implicit none - ! Arguments - class(walltimer), intent(inout) :: self !! Walltimer object - character(len=*), intent(in) :: message !! Message to prepend to the wall time terminal output - integer(I4B), optional, intent(in) :: nsubsteps !! Number of substeps used to compute the time per step - ! Internals - character(len=*), parameter :: nosubstepfmt = '" Total wall time: ", es12.5, "; Interval wall time: ", es12.5 ' - character(len=*), parameter :: substepfmt = '" Total wall time: ", es12.5, "; Interval wall time: ", es12.5, ";' //& - 'Interval wall time/step: ", es12.5' - character(len=STRMAX) :: fmt - integer(I8B) :: count_delta_step, count_delta_main, count_now - real(DP) :: wall_main !! Value of total elapsed time at the end of a timed step - real(DP) :: wall_step !! Value of elapsed time since the start of a timed step - real(DP) :: wall_per_substep !! Value of time per substep - - if (.not.self%main_is_started) then - write(*,*) "Wall timer error: The step finish time cannot be calculated because the timer is not started!" - return - end if - - call system_clock(count_now) - count_delta_main = count_now - self%count_start_main - count_delta_step = count_now - self%count_start_step - wall_main = count_delta_main / (self%count_rate * 1.0_DP) - wall_step = count_delta_step / (self%count_rate * 1.0_DP) - if (present(nsubsteps)) then - wall_per_substep = wall_step / nsubsteps - fmt = '("' // adjustl(message) // '",' // substepfmt // ')' - write(*,trim(adjustl(fmt))) wall_main, self%wall_step, wall_per_substep - else - fmt = '("' // adjustl(message) // '",' // nosubstepfmt // ')' - write(*,trim(adjustl(fmt))) wall_main, self%wall_step - end if - - - return - end subroutine walltime_report - - - module subroutine walltime_reset(self) - !! author: David A. Minton - !! - !! Resets the step timer - implicit none - ! Arguments - class(walltimer), intent(inout) :: self !! Walltimer object - ! Internals - - self%is_paused = .false. - self%wall_step = 0.0_DP - - return - end subroutine walltime_reset - - - module subroutine walltime_start_main(self) - !! author: David A. Minton - !! - !! Resets the clock ticker, settting main_start to the current ticker value - implicit none - ! Arguments - class(walltimer), intent(inout) :: self !! Walltimer object - - call system_clock(self%count_start_main, self%count_rate, self%count_max) - self%main_is_started = .true. - - return - end subroutine walltime_start_main - - - module subroutine walltime_start(self) - !! author: David A. Minton - !! - !! Starts or resumes the step timer - !! - implicit none - ! Arguments - class(walltimer), intent(inout) :: self !! Walltimer object - ! Internals - integer(I8B) :: count_resume, count_delta - - - if (.not.self%main_is_started) then - call self%reset() - call self%start_main() - end if - - if (self%is_paused) then ! Resume a paused step timer - call system_clock(count_resume) - count_delta = count_resume - self%count_pause - self%count_pause = 0_I8B - self%count_start_step = self%count_start_step + count_delta - self%is_paused = .false. - else ! Start a new step timer - call system_clock(self%count_start_step) - end if - - return - end subroutine walltime_start - - - module subroutine walltime_interaction_adapt(self, param, ninteractions, pl) - !! author: David A. Minton - !! - !! Determines which of the two loop styles is fastest and keeps that one - implicit none - ! Arguments - class(interaction_timer), intent(inout) :: self !! Walltimer object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I8B), intent(in) :: ninteractions !! Current number of interactions (used to normalize the timed loop and to determine if number of interactions has changed since the last timing - class(swiftest_pl), intent(inout), optional :: pl !! Swiftest massive body object - ! Internals - character(len=STRMAX) :: nstr, cstr, mstr - character(len=11) :: lstyle, advancedstyle, standardstyle - character(len=1) :: schar - logical :: ladvanced_final - character(len=NAMELEN) :: logfile - - ! Record the elapsed time - call self%stop() - - select case(trim(adjustl(self%looptype))) - case("INTERACTION") - write(advancedstyle, *) "FLAT " - write(standardstyle, *) "TRIANGULAR" - write(logfile,*) INTERACTION_TIMER_LOG_OUT - case("ENCOUNTER_PLPL") - write(advancedstyle, *) "SORTSWEEP " - write(standardstyle, *) "TRIANGULAR" - write(logfile,*) ENCOUNTER_PLPL_TIMER_LOG_OUT - case("ENCOUNTER_PLTP") - write(advancedstyle, *) "SORTSWEEP " - write(standardstyle, *) "TRIANGULAR" - write(logfile,*) ENCOUNTER_PLTP_TIMER_LOG_OUT - case default - write(logfile,*) "unknown_looptimer.log" - end select - - write(schar,'(I1)') self%stage - write(nstr,*) ninteractions - - select case(self%stage) - case(1) - if (self%stage1_is_advanced) then - lstyle = advancedstyle - else - lstyle = standardstyle - end if - self%stage1_metric = (self%count_stop_step - self%count_start_step) / real(ninteractions, kind=DP) - write(mstr,*) self%stage1_metric - case(2) - if (.not.self%stage1_is_advanced) then - lstyle = advancedstyle - else - lstyle = standardstyle - end if - - self%stage2_metric = (self%count_stop_step - self%count_start_step) / real(ninteractions, kind=DP) - self%is_on = .false. - self%step_counter = 0 - if (self%stage1_metric < self%stage2_metric) then - ladvanced_final = self%stage1_is_advanced - call self%flip(param, pl) ! Go back to the original style, otherwise keep the stage2 style - else - ladvanced_final = .not.self%stage1_is_advanced - end if - write(mstr,*) self%stage2_metric - end select - - write(cstr,*) self%count_stop_step - self%count_start_step - - call io_log_one_message(logfile, adjustl(lstyle) // " " // trim(adjustl(cstr)) // " " // & - trim(adjustl(nstr)) // " " // trim(adjustl(mstr))) - - if (self%stage == 2) then - if (ladvanced_final) then - lstyle = advancedstyle - else - lstyle = standardstyle - end if - call io_log_one_message(logfile, trim(adjustl(self%loopname)) // & - ": the fastest loop method tested is " // trim(adjustl(lstyle))) - end if - - return - end subroutine walltime_interaction_adapt - - - module function walltime_interaction_check(self, param, ninteractions) result(ltimeit) - !! author: David A. Minton - !! - !! Checks whether or not the loop should be timed and starts the timer if the conditions for starting are met - implicit none - ! Arguments - class(interaction_timer), intent(inout) :: self !! Walltimer object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I8B), intent(in) :: ninteractions !! Current number of interactions (used to normalize the timed loop and to determine if number of interactions has changed since the last timing - logical :: ltimeit !! Logical flag indicating whether this loop should be timed or not - - if (self%is_on) then ! Entering the second stage of the loop timing. Therefore we will swap the interaction style and time this loop - self%stage = self%stage + 1 - ltimeit = (self%stage == 2) - else - self%step_counter = min(self%step_counter + 1, INTERACTION_TIMER_CADENCE) - ltimeit = .false. - if (self%step_counter == INTERACTION_TIMER_CADENCE) then - ltimeit = (ninteractions /= self%last_interactions) - if (ltimeit) self%stage = 1 - end if - end if - self%is_on = ltimeit - - return - end function walltime_interaction_check - - - module subroutine walltime_interaction_flip_loop_style(self, param, pl) - !! author: David A. Minton - !! - !! Flips the interaction loop style from FLAT to TRIANGULAR or vice versa - implicit none - ! Arguments - class(interaction_timer), intent(inout) :: self !! Interaction loop timer object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(swiftest_pl), intent(inout), optional :: pl !! Swiftest massive body object - - select case(trim(adjustl(self%looptype))) - case("INTERACTION") - param%lflatten_interactions = .not. param%lflatten_interactions - case("ENCOUNTER_PLPL") - param%lencounter_sas_plpl= .not. param%lencounter_sas_plpl - case("ENCOUNTER_PLTP") - param%lencounter_sas_pltp= .not. param%lencounter_sas_pltp - end select - - if (present(pl)) then - if (param%lflatten_interactions) then - call pl%flatten(param) - else - if (allocated(pl%k_plpl)) deallocate(pl%k_plpl) - end if - end if - - return - end subroutine walltime_interaction_flip_loop_style - - - module subroutine walltime_interaction_time_this_loop(self, param, ninteractions, pl) - !! author: David A. Minton - !! - !! Resets the interaction loop timer, and saves the current value of the array flatten parameter - implicit none - ! Arguments - class(interaction_timer), intent(inout) :: self !! Interaction loop timer object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I8B), intent(in) :: ninteractions !! Current number of interactions (used to normalize the timed loop) - class(swiftest_pl), intent(inout), optional :: pl !! Swiftest massive body object - ! Internals - character(len=STRMAX) :: tstr - character(len=1) :: schar - character(len=NAMELEN) :: logfile - - select case(trim(adjustl(self%looptype))) - case("INTERACTION") - write(logfile,*) INTERACTION_TIMER_LOG_OUT - case("ENCOUNTER_PLPL") - write(logfile,*) ENCOUNTER_PLPL_TIMER_LOG_OUT - case("ENCOUNTER_PLTP") - write(logfile,*) ENCOUNTER_PLTP_TIMER_LOG_OUT - case default - write(logfile,*) "unknown_looptimer.log" - end select - - self%is_on = .true. - write(tstr,*) param%t - select case(self%stage) - case(1) - self%stage1_ninteractions = ninteractions - select case(trim(adjustl(self%looptype))) - case("INTERACTION") - self%stage1_is_advanced = param%lflatten_interactions - case("ENCOUNTER_PLPL") - self%stage1_is_advanced = param%lencounter_sas_plpl - case("ENCOUNTER_PLTP") - self%stage1_is_advanced = param%lencounter_sas_pltp - end select - call io_log_one_message(logfile, trim(adjustl(self%loopname)) // ": loop timer turned on at t = " // trim(adjustl(tstr))) - case(2) - select case(trim(adjustl(self%looptype))) - case("INTERACTION") - param%lflatten_interactions = self%stage1_is_advanced - case("ENCOUNTER_PLPL") - param%lencounter_sas_plpl= self%stage1_is_advanced - case("ENCOUNTER_PLTP") - param%lencounter_sas_pltp= self%stage1_is_advanced - end select - call self%flip(param, pl) - case default - self%stage = 1 - end select - - write(schar,'(I1)') self%stage - call io_log_one_message(logfile, trim(adjustl(self%loopname)) // ": stage " // schar ) - - call self%reset() - call self%start() - - return - end subroutine walltime_interaction_time_this_loop - -end submodule s_walltime \ No newline at end of file diff --git a/src/walltime/walltime_implementations.f90 b/src/walltime/walltime_implementations.f90 new file mode 100644 index 000000000..c0804b664 --- /dev/null +++ b/src/walltime/walltime_implementations.f90 @@ -0,0 +1,143 @@ +!! 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. + +submodule(walltime) s_walltime + use swiftest +contains + + module subroutine walltime_stop(self) + !! author: David A. Minton + !! + !! Pauses the step timer (but not the main timer). + implicit none + ! Arguments + class(walltimer), intent(inout) :: self !! Walltimer object + ! Internals + integer(I8B) :: count_delta + + if (self%is_paused) then + write(*,*) "Wall timer error: Timer is already paused!" + return + end if + + call system_clock(self%count_pause) + self%is_paused = .true. + + self%count_stop_step = self%count_pause + + count_delta = self%count_stop_step - self%count_start_step + self%wall_step = count_delta / (self%count_rate * 1.0_DP) + + return + end subroutine walltime_stop + + + module subroutine walltime_report(self, message, unit, nsubsteps) + !! author: David A. Minton + !! + !! Prints the elapsed time information to the terminal + implicit none + ! Arguments + class(walltimer), intent(inout) :: self !! Walltimer object + character(len=*), intent(in) :: message !! Message to prepend to the wall time terminal output + integer(I4B), intent(in) :: unit !! Output file unit for report text to be directed + integer(I4B), optional, intent(in) :: nsubsteps !! Number of substeps used to compute the time per step + ! Internals + character(len=*), parameter :: nosubstepfmt = '" Total wall time: ", es12.5, "; Interval wall time: ", es12.5 ' + character(len=*), parameter :: substepfmt = '" Total wall time: ", es12.5, "; Interval wall time: ", es12.5, ";' //& + 'Interval wall time/step: ", es12.5' + character(len=STRMAX) :: fmt + integer(I8B) :: count_delta_step, count_delta_main, count_now + + if (.not.self%main_is_started) then + write(*,*) "Wall timer error: The step finish time cannot be calculated because the timer is not started!" + return + end if + + call system_clock(count_now) + count_delta_main = count_now - self%count_start_main + count_delta_step = count_now - self%count_start_step + self%wall_main = count_delta_main / (self%count_rate * 1.0_DP) + self%wall_step = count_delta_step / (self%count_rate * 1.0_DP) + if (present(nsubsteps)) then + self%wall_per_substep = self%wall_step / nsubsteps + fmt = '("' // adjustl(message) // '",' // substepfmt // ')' + write(unit,trim(adjustl(fmt))) self%wall_main, self%wall_step, self%wall_per_substep + else + fmt = '("' // adjustl(message) // '",' // nosubstepfmt // ')' + write(unit,trim(adjustl(fmt))) self%wall_main, self%wall_step + end if + + return + end subroutine walltime_report + + + module subroutine walltime_reset(self) + !! author: David A. Minton + !! + !! Resets the step timer + implicit none + ! Arguments + class(walltimer), intent(inout) :: self !! Walltimer object + ! Internals + + self%is_paused = .false. + self%wall_step = 0.0_DP + self%wall_per_substep = 0.0_DP + + return + end subroutine walltime_reset + + + module subroutine walltime_start_main(self) + !! author: David A. Minton + !! + !! Resets the clock ticker, settting main_start to the current ticker value + implicit none + ! Arguments + class(walltimer), intent(inout) :: self !! Walltimer object + + call system_clock(self%count_start_main, self%count_rate, self%count_max) + self%main_is_started = .true. + self%wall_main = 0.0_DP + + return + end subroutine walltime_start_main + + + module subroutine walltime_start(self) + !! author: David A. Minton + !! + !! Starts or resumes the step timer + !! + implicit none + ! Arguments + class(walltimer), intent(inout) :: self !! Walltimer object + ! Internals + integer(I8B) :: count_resume, count_delta + + if (.not.self%main_is_started) then + call self%reset() + call self%start_main() + end if + + if (self%is_paused) then ! Resume a paused step timer + call system_clock(count_resume) + count_delta = count_resume - self%count_pause + self%count_pause = 0_I8B + self%count_start_step = self%count_start_step + count_delta + self%is_paused = .false. + else ! Start a new step timer + call system_clock(self%count_start_step) + end if + + return + end subroutine walltime_start + +end submodule s_walltime \ No newline at end of file diff --git a/src/walltime/walltime_module.f90 b/src/walltime/walltime_module.f90 new file mode 100644 index 000000000..6ccce25b1 --- /dev/null +++ b/src/walltime/walltime_module.f90 @@ -0,0 +1,76 @@ +!! 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. + +module walltime + !! author: David A. Minton + !! + !! Classes and methods used to compute elasped wall time + use globals + use base + implicit none + public + + integer(I4B) :: INTERACTION_TIMER_CADENCE = 1000 !! Minimum number of steps to wait before timing an interaction loop in ADAPTIVE mode + character(len=*), parameter :: INTERACTION_TIMER_LOG_OUT = "interaction_timer.log" !! Name of log file for recording results of interaction loop timing + character(len=*), parameter :: ENCOUNTER_PLPL_TIMER_LOG_OUT = "encounter_check_plpl_timer.log" !! Name of log file for recording results of encounter check method timing + character(len=*), parameter :: ENCOUNTER_PLTP_TIMER_LOG_OUT = "encounter_check_pltp_timer.log" !! Name of log file for recording results of encounter check method timing + + type :: walltimer + integer(I8B) :: count_rate !! Rate at wich the clock ticks + integer(I8B) :: count_max !! Maximum value of the clock ticker + integer(I8B) :: count_start_main !! Value of the clock ticker at when the timer is first called + integer(I8B) :: count_start_step !! Value of the clock ticker at the start of a timed step + integer(I8B) :: count_stop_step !! Value of the clock ticker at the end of a timed step + integer(I8B) :: count_pause !! Value of the clock ticker at the end of a timed step + real(DP) :: wall_step !! Value of the step elapsed time + real(DP) :: wall_main !! Value of the main clock elapsed time + real(DP) :: wall_per_substep !! Value of time per substep + logical :: main_is_started = .false. !! Logical flag indicating whether or not the main timer has been reset or not + logical :: is_paused = .false. !! Logical flag indicating whether or not the timer is paused + + contains + procedure :: reset => walltime_reset !! Resets the clock ticker, settting main_start to the current ticker value + procedure :: start => walltime_start !! Starts or resumes the step timer + procedure :: start_main => walltime_start_main !! Starts the main timer + procedure :: stop => walltime_stop !! Pauses the step timer + procedure :: report => walltime_report !! Prints the elapsed time information to the terminal + end type walltimer + + + interface + module subroutine walltime_report(self, message, unit, nsubsteps) + implicit none + class(walltimer), intent(inout) :: self !! Walltimer object + character(len=*), intent(in) :: message !! Message to prepend to the wall time terminal output + integer(I4B), intent(in) :: unit !! Output file unit for report text to be directed + integer(I4B), optional, intent(in) :: nsubsteps !! Number of substeps used to compute the time per step + end subroutine walltime_report + + module subroutine walltime_reset(self) + implicit none + class(walltimer), intent(inout) :: self !! Walltimer object + end subroutine walltime_reset + + module subroutine walltime_start(self) + implicit none + class(walltimer), intent(inout) :: self !! Walltimer object + end subroutine walltime_start + + module subroutine walltime_start_main(self) + implicit none + class(walltimer), intent(inout) :: self !! Walltimer object + end subroutine walltime_start_main + + module subroutine walltime_stop(self) + implicit none + class(walltimer), intent(inout) :: self !! Walltimer object + end subroutine walltime_stop + end interface + +end module walltime \ No newline at end of file diff --git a/src/whm/whm_coord.f90 b/src/whm/whm_coord.f90 index 2b888a279..5ecfeedcc 100644 --- a/src/whm/whm_coord.f90 +++ b/src/whm/whm_coord.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (whm_classes) s_whm_coord +submodule (whm) s_whm_coord use swiftest contains @@ -31,18 +31,18 @@ module subroutine whm_coord_h2j_pl(self, cb) if (self%nbody == 0) return - associate(npl => self%nbody, GMpl => self%Gmass, eta => self%eta, xh => self%xh, vh => self%vh, & + associate(npl => self%nbody, GMpl => self%Gmass, eta => self%eta, rh => self%rh, vh => self%vh, & xj => self%xj, vj => self%vj) - xj(:, 1) = xh(:, 1) + xj(:, 1) = rh(:, 1) vj(:, 1) = vh(:, 1) sumx(:) = 0.0_DP sumv(:) = 0.0_DP do i = 2, npl - sumx(:) = sumx(:) + GMpl(i - 1) * xh(:, i - 1) + sumx(:) = sumx(:) + GMpl(i - 1) * rh(:, i - 1) sumv(:) = sumv(:) + GMpl(i - 1) * vh(:, i - 1) cap(:) = sumx(:) / eta(i - 1) capv(:) = sumv(:) / eta(i - 1) - xj(:, i) = xh(:, i) - cap(:) + xj(:, i) = rh(:, i) - cap(:) vj(:, i) = vh(:, i) - capv(:) end do end associate @@ -72,16 +72,16 @@ module subroutine whm_coord_j2h_pl(self, cb) if (self%nbody == 0) return - associate(npl => self%nbody, GMpl => self%Gmass, eta => self%eta, xh => self%xh, vh => self%vh, & + associate(npl => self%nbody, GMpl => self%Gmass, eta => self%eta, rh => self%rh, vh => self%vh, & xj => self%xj, vj => self%vj) - xh(:, 1) = xj(:, 1) + rh(:, 1) = xj(:, 1) vh(:, 1) = vj(:, 1) sumx(:) = 0.0_DP sumv(:) = 0.0_DP do i = 2, npl sumx(:) = sumx(:) + GMpl(i - 1) * xj(:, i - 1) / eta(i - 1) sumv(:) = sumv(:) + GMpl(i - 1) * vj(:, i - 1) / eta(i - 1) - xh(:, i) = xj(:, i) + sumx(:) + rh(:, i) = xj(:, i) + sumx(:) vh(:, i) = vj(:, i) + sumv(:) end do end associate diff --git a/src/whm/whm_drift.f90 b/src/whm/whm_drift.f90 index 4efefe2b5..21a092793 100644 --- a/src/whm/whm_drift.f90 +++ b/src/whm/whm_drift.f90 @@ -7,11 +7,11 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(whm_classes) whm_drift +submodule(whm) whm_drift use swiftest contains - module subroutine whm_drift_pl(self, system, param, dt) + module subroutine whm_drift_pl(self, nbody_system, param, dt) !! author: David A. Minton !! !! Loop through planets and call Danby drift routine @@ -21,7 +21,7 @@ module subroutine whm_drift_pl(self, system, param, dt) implicit none ! Arguments class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! WHM nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! WHM nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize ! Internals @@ -33,7 +33,7 @@ module subroutine whm_drift_pl(self, system, param, dt) associate(pl => self, npl => self%nbody) allocate(iflag(npl)) iflag(:) = 0 - call drift_all(pl%muj, pl%xj, pl%vj, npl, param, dt, pl%lmask, iflag) + call swiftest_drift_all(pl%muj, pl%xj, pl%vj, npl, param, dt, pl%lmask, iflag) if (any(iflag(1:npl) /= 0)) then where(iflag(1:npl) /= 0) pl%status(1:npl) = DISCARDED_DRIFTERR diff --git a/src/whm/whm_gr.f90 b/src/whm/whm_gr.f90 index 02dc7d4a4..b0891f006 100644 --- a/src/whm/whm_gr.f90 +++ b/src/whm/whm_gr.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(whm_classes) s_whm_gr +submodule(whm) s_whm_gr use swiftest contains @@ -31,7 +31,7 @@ pure module subroutine whm_gr_kick_getacch_pl(self, param) if (self%nbody == 0) return associate(pl => self, npl => self%nbody, inv_c2 => param%inv_c2) - call gr_kick_getacch(pl%muj, pl%xj, pl%lmask, npl, param%inv_c2, pl%agr) + call swiftest_gr_kick_getacch(pl%muj, pl%xj, pl%lmask, npl, param%inv_c2, pl%agr) suma(:) = 0.0_DP pl%ah(:, 1) = pl%ah(:, 1) + pl%agr(:, 1) do i = 2, npl @@ -62,7 +62,7 @@ pure module subroutine whm_gr_kick_getacch_tp(self, param) if (self%nbody == 0) return associate(tp => self, ntp => self%nbody, inv_c2 => param%inv_c2) - call gr_kick_getacch(tp%mu, tp%xh, tp%lmask, ntp, param%inv_c2, tp%agr) + call swiftest_gr_kick_getacch(tp%mu, tp%rh, tp%lmask, ntp, param%inv_c2, tp%agr) tp%ah(:,1:ntp) = tp%ah(:,1:ntp) + tp%agr(:,1:ntp) end associate @@ -70,7 +70,7 @@ pure module subroutine whm_gr_kick_getacch_tp(self, param) end subroutine whm_gr_kick_getacch_tp - pure module subroutine whm_gr_p4_pl(self, system, param, dt) + pure module subroutine whm_gr_p4_pl(self, nbody_system, param, dt) !! author: David A. Minton !! !! Position kick to massive bodies due to p**4 term in the post-Newtonian correction @@ -80,7 +80,7 @@ pure module subroutine whm_gr_p4_pl(self, system, param, dt) implicit none ! Arguments class(whm_pl), intent(inout) :: self !! Swiftest particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size ! Internals @@ -89,7 +89,7 @@ pure module subroutine whm_gr_p4_pl(self, system, param, dt) associate(pl => self, npl => self%nbody) if (npl == 0) return do concurrent(i = 1:npl, pl%lmask(i)) - call gr_p4_pos_kick(param, pl%xj(:, i), pl%vj(:, i), dt) + call swiftest_gr_p4_pos_kick(param, pl%xj(:, i), pl%vj(:, i), dt) end do end associate @@ -97,7 +97,7 @@ pure module subroutine whm_gr_p4_pl(self, system, param, dt) end subroutine whm_gr_p4_pl - pure module subroutine whm_gr_p4_tp(self, system, param, dt) + pure module subroutine whm_gr_p4_tp(self, nbody_system, param, dt) !! author: David A. Minton !! !! Position kick to test particles due to p**4 term in the post-Newtonian correction @@ -107,7 +107,7 @@ pure module subroutine whm_gr_p4_tp(self, system, param, dt) implicit none ! Arguments class(whm_tp), intent(inout) :: self !! Swiftest particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size ! Internals @@ -116,7 +116,7 @@ pure module subroutine whm_gr_p4_tp(self, system, param, dt) associate(tp => self, ntp => self%nbody) if (ntp == 0) return do concurrent(i = 1:ntp, tp%lmask(i)) - call gr_p4_pos_kick(param, tp%xh(:, i), tp%vh(:, i), dt) + call swiftest_gr_p4_pos_kick(param, tp%rh(:, i), tp%vh(:, i), dt) end do end associate diff --git a/src/whm/whm_kick.f90 b/src/whm/whm_kick.f90 index 54a6ef621..6469809e5 100644 --- a/src/whm/whm_kick.f90 +++ b/src/whm/whm_kick.f90 @@ -7,11 +7,11 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(whm_classes) s_whm_kick +submodule(whm) s_whm_kick use swiftest contains - module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) + module subroutine whm_kick_getacch_pl(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Compute heliocentric accelerations of planets @@ -21,7 +21,7 @@ module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) implicit none ! Arguments class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest central body particle data structure + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest central body particle data structure class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step @@ -31,10 +31,10 @@ module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) if (self%nbody == 0) return - associate(cb => system%cb, pl => self, npl => self%nbody) + associate(cb => nbody_system%cb, pl => self, npl => self%nbody) call pl%set_ir3() - ah0(:) = whm_kick_getacch_ah0(pl%Gmass(2:npl), pl%xh(:,2:npl), npl-1) + ah0(:) = whm_kick_getacch_ah0(pl%Gmass(2:npl), pl%rh(:,2:npl), npl-1) do i = 1, npl pl%ah(:, i) = pl%ah(:, i) + ah0(:) end do @@ -44,7 +44,7 @@ module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) call pl%accel_int(param) if (param%loblatecb) then - call pl%accel_obl(system) + call pl%accel_obl(nbody_system) if (lbeg) then cb%aoblbeg = cb%aobl else @@ -53,21 +53,21 @@ module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) ! TODO: Implement tides ! if (param%ltides) then ! cb%atidebeg = cb%aobl - ! call pl%accel_tides(system) + ! call pl%accel_tides(nbody_system) ! cb%atideend = cb%atide ! end if end if if (param%lgr) call pl%accel_gr(param) - if (param%lextra_force) call pl%accel_user(system, param, t, lbeg) + if (param%lextra_force) call pl%accel_user(nbody_system, param, t, lbeg) end associate return end subroutine whm_kick_getacch_pl - module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) + module subroutine whm_kick_getacch_tp(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Compute heliocentric accelerations of test particles @@ -77,7 +77,7 @@ module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) implicit none ! Arguments class(whm_tp), intent(inout) :: self !! WHM test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest central body particle data structure + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest central body particle data structure class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step @@ -85,26 +85,26 @@ module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) integer(I4B) :: i real(DP), dimension(NDIM) :: ah0 - associate(tp => self, ntp => self%nbody, pl => system%pl, cb => system%cb, npl => system%pl%nbody) + associate(tp => self, ntp => self%nbody, pl => nbody_system%pl, cb => nbody_system%cb, npl => nbody_system%pl%nbody) if (ntp == 0 .or. npl == 0) return - system%lbeg = lbeg + nbody_system%lbeg = lbeg if (lbeg) then - ah0(:) = whm_kick_getacch_ah0(pl%Gmass(1:npl), pl%xbeg(:, 1:npl), npl) + ah0(:) = whm_kick_getacch_ah0(pl%Gmass(1:npl), pl%rbeg(:, 1:npl), npl) do concurrent(i = 1:ntp, tp%lmask(i)) tp%ah(:, i) = tp%ah(:, i) + ah0(:) end do - call tp%accel_int(param, pl%Gmass(1:npl), pl%xbeg(:, 1:npl), npl) + 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%xend(:, 1:npl), npl) + ah0(:) = whm_kick_getacch_ah0(pl%Gmass(1:npl), pl%rend(:, 1:npl), npl) do concurrent(i = 1:ntp, tp%lmask(i)) tp%ah(:, i) = tp%ah(:, i) + ah0(:) end do - call tp%accel_int(param, pl%Gmass(1:npl), pl%xend(:, 1:npl), npl) + call tp%accel_int(param, pl%Gmass(1:npl), pl%rend(:, 1:npl), npl) end if - if (param%loblatecb) call tp%accel_obl(system) - if (param%lextra_force) call tp%accel_user(system, param, t, lbeg) + if (param%loblatecb) call tp%accel_obl(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 @@ -112,14 +112,14 @@ module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) end subroutine whm_kick_getacch_tp - function whm_kick_getacch_ah0(mu, xhp, n) result(ah0) + function whm_kick_getacch_ah0(mu, rhp, n) result(ah0) !! author: David A. Minton !! !! Compute zeroth term heliocentric accelerations of planets implicit none ! Arguments real(DP), dimension(:), intent(in) :: mu - real(DP), dimension(:,:), intent(in) :: xhp + real(DP), dimension(:,:), intent(in) :: rhp integer(I4B), intent(in) :: n ! Result real(DP), dimension(NDIM) :: ah0 @@ -129,11 +129,11 @@ function whm_kick_getacch_ah0(mu, xhp, n) result(ah0) ah0(:) = 0.0_DP do i = 1, n - r2 = dot_product(xhp(:, i), xhp(:, i)) + r2 = dot_product(rhp(:, i), rhp(:, i)) irh = 1.0_DP / sqrt(r2) ir3h = irh / r2 fac = mu(i) * ir3h - ah0(:) = ah0(:) - fac * xhp(:, i) + ah0(:) = ah0(:) - fac * rhp(:, i) end do return @@ -158,7 +158,7 @@ pure subroutine whm_kick_getacch_ah1(cb, pl) associate(npl => pl%nbody) do concurrent (i = 2:npl, pl%lmask(i)) ah1j(:) = pl%xj(:, i) * pl%ir3j(i) - ah1h(:) = pl%xh(:, i) * pl%ir3h(i) + ah1h(:) = pl%rh(:, i) * pl%ir3h(i) pl%ah(:, i) = pl%ah(:, i) + cb%Gmass * (ah1j(:) - ah1h(:)) end do end associate @@ -200,7 +200,7 @@ pure subroutine whm_kick_getacch_ah2(cb, pl) end subroutine whm_kick_getacch_ah2 - module subroutine whm_kick_vh_pl(self, system, param, t, dt, lbeg) + module subroutine whm_kick_vh_pl(self, nbody_system, param, t, dt, lbeg) !! author: David A. Minton !! !! Kick heliocentric velocities of massive bodies @@ -210,7 +210,7 @@ module subroutine whm_kick_vh_pl(self, system, param, t, dt, lbeg) implicit none ! Arguments class(whm_pl), intent(inout) :: self !! WHM massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system 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 !! Current time real(DP), intent(in) :: dt !! Stepsize @@ -218,20 +218,20 @@ module subroutine whm_kick_vh_pl(self, system, param, t, dt, lbeg) ! Internals integer(I4B) :: i - associate(pl => self, npl => self%nbody, cb => system%cb) + associate(pl => self, npl => self%nbody, cb => nbody_system%cb) if (npl == 0) return if (lbeg) then if (pl%lfirst) then call pl%h2j(cb) pl%ah(:, 1:npl) = 0.0_DP - call pl%accel(system, param, t, lbeg) + call pl%accel(nbody_system, param, t, lbeg) pl%lfirst = .false. end if - call pl%set_beg_end(xbeg = pl%xh) + call pl%set_beg_end(rbeg = pl%rh) else pl%ah(:, 1:npl) = 0.0_DP - call pl%accel(system, param, t, lbeg) - call pl%set_beg_end(xend = pl%xh) + call pl%accel(nbody_system, param, t, lbeg) + call pl%set_beg_end(rend = pl%rh) end if do concurrent(i = 1:npl, pl%lmask(i)) pl%vh(:, i) = pl%vh(:, i) + pl%ah(:, i) * dt @@ -242,7 +242,7 @@ module subroutine whm_kick_vh_pl(self, system, param, t, dt, lbeg) end subroutine whm_kick_vh_pl - module subroutine whm_kick_vh_tp(self, system, param, t, dt, lbeg) + module subroutine whm_kick_vh_tp(self, nbody_system, param, t, dt, lbeg) !! author: David A. Minton !! !! Kick heliocentric velocities of test particles @@ -252,7 +252,7 @@ module subroutine whm_kick_vh_tp(self, system, param, t, dt, lbeg) implicit none ! Arguments class(whm_tp), intent(inout) :: self !! WHM massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system 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 !! Current time real(DP), intent(in) :: dt !! Stepsize @@ -267,14 +267,14 @@ module subroutine whm_kick_vh_tp(self, system, param, t, dt, lbeg) do concurrent(i = 1:ntp, tp%lmask(i)) tp%ah(:, i) = 0.0_DP end do - call tp%accel(system, param, t, lbeg=.true.) + call tp%accel(nbody_system, param, t, lbeg=.true.) tp%lfirst = .false. end if if (.not.lbeg) then do concurrent(i = 1:ntp, tp%lmask(i)) tp%ah(:, i) = 0.0_DP end do - call tp%accel(system, param, t, lbeg) + call tp%accel(nbody_system, param, t, lbeg) end if do concurrent(i = 1:ntp, tp%lmask(i)) tp%vh(:, i) = tp%vh(:, i) + tp%ah(:, i) * dt diff --git a/src/modules/whm_classes.f90 b/src/whm/whm_module.f90 similarity index 73% rename from src/modules/whm_classes.f90 rename to src/whm/whm_module.f90 index 34922c29a..d902065f6 100644 --- a/src/modules/whm_classes.f90 +++ b/src/whm/whm_module.f90 @@ -7,27 +7,20 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -module whm_classes +module whm !! author: David A. Minton !! !! Definition of classes and methods specific to the Democratic Heliocentric Method !! Partially adapted from David E. Kaufmann's Swifter module: module_whm.f90 - use swiftest_globals - use swiftest_classes, only : swiftest_cb, swiftest_pl, swiftest_tp, swiftest_nbody_system + use swiftest implicit none public - !******************************************************************************************************************************** - ! whm_cb class definitions and method interfaces - !******************************************************************************************************************************* !> Swiftest central body particle class type, extends(swiftest_cb) :: whm_cb contains end type whm_cb - !******************************************************************************************************************************** - ! whm_pl class definitions and method interfaces - !******************************************************************************************************************************* !> WHM massive body particle class type, extends(swiftest_pl) :: whm_pl @@ -37,7 +30,7 @@ module whm_classes real(DP), dimension(:), allocatable :: muj !! Jacobi mu: GMcb * eta(i) / eta(i - 1) real(DP), dimension(:), allocatable :: ir3j !! Third term of heliocentric acceleration !! Note to developers: If you add componenets to this class, be sure to update methods and subroutines that traverse the - !! component list, such as whm_setup_pl and whm_util_spill_pl + !! component list, such as whm_util_setup_pl and whm_util_spill_pl contains procedure :: h2j => whm_coord_h2j_pl !! Convert position and velcoity vectors from heliocentric to Jacobi coordinates procedure :: j2h => whm_coord_j2h_pl !! Convert position and velcoity vectors from Jacobi to helliocentric coordinates @@ -56,14 +49,11 @@ module whm_classes procedure :: sort => whm_util_sort_pl !! Sort a WHM massive body object in-place. procedure :: rearrange => whm_util_sort_rearrange_pl !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods procedure :: spill => whm_util_spill_pl !!"Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - procedure :: setup => whm_setup_pl !! Constructor method - Allocates space for the input number of bodiess + procedure :: setup => whm_util_setup_pl !! Constructor method - Allocates space for the input number of bodiess procedure :: step => whm_step_pl !! Steps the body forward one stepsize - final :: whm_util_final_pl !! Finalizes the WHM massive body object - deallocates all allocatables + final :: whm_final_pl !! Finalizes the WHM massive body object - deallocates all allocatables end type whm_pl - !******************************************************************************************************************************** - ! whm_tp class definitions and method interfaces - !******************************************************************************************************************************* !! WHM test particle class type, extends(swiftest_tp) :: whm_tp @@ -75,90 +65,79 @@ module whm_classes procedure :: accel => whm_kick_getacch_tp !! Compute heliocentric accelerations of test particles procedure :: kick => whm_kick_vh_tp !! Kick heliocentric velocities of test particles procedure :: step => whm_step_tp !! Steps the particle forward one stepsize - final :: whm_util_final_tp !! Finalizes the WHM test particle object - deallocates all allocatables + final :: whm_final_tp !! Finalizes the WHM test particle object - deallocates all allocatables end type whm_tp - !******************************************************************************************************************************** - ! whm_nbody_system class definitions and method interfaces - !******************************************************************************************************************************** !> An abstract class for the WHM integrator nbody system type, extends(swiftest_nbody_system) :: whm_nbody_system contains !> Replace the abstract procedures with concrete ones - procedure :: initialize => whm_setup_initialize_system !! Performs WHM-specific initilization steps, like calculating the Jacobi masses + procedure :: initialize => whm_util_setup_initialize_system !! Performs WHM-specific initilization steps, like calculating the Jacobi masses procedure :: step => whm_step_system !! Advance the WHM nbody system forward in time by one step - final :: whm_util_final_system !! Finalizes the WHM system object - deallocates all allocatables + final :: whm_final_system !! Finalizes the WHM nbody_system object - deallocates all allocatables end type whm_nbody_system interface module subroutine whm_coord_h2j_pl(self, cb) - use swiftest_classes, only : swiftest_cb implicit none class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure class(swiftest_cb), intent(inout) :: cb !! Swiftest central body particle data structuree end subroutine whm_coord_h2j_pl module subroutine whm_coord_j2h_pl(self, cb) - use swiftest_classes, only : swiftest_cb implicit none class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure class(swiftest_cb), intent(inout) :: cb !! Swiftest central body particle data structuree end subroutine whm_coord_j2h_pl module subroutine whm_coord_vh2vj_pl(self, cb) - use swiftest_classes, only : swiftest_cb implicit none class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure class(swiftest_cb), intent(inout) :: cb !! Swiftest central body particle data structuree end subroutine whm_coord_vh2vj_pl - module subroutine whm_drift_pl(self, system, param, dt) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters + module subroutine whm_drift_pl(self, nbody_system, param, dt) implicit none class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! WHM nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! WHM nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize end subroutine whm_drift_pl !> Get heliocentric accelration of massive bodies - module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) - use swiftest_classes, only : swiftest_cb, swiftest_parameters + module subroutine whm_kick_getacch_pl(self, nbody_system, param, t, lbeg) implicit none class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! WHM nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! WHM 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 !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine whm_kick_getacch_pl !> Get heliocentric accelration of the test particle - module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) - use swiftest_classes, only : swiftest_cb, swiftest_parameters + module subroutine whm_kick_getacch_tp(self, nbody_system, param, t, lbeg) implicit none class(whm_tp), intent(inout) :: self !! WHM test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! WHM nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! WHM nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine whm_kick_getacch_tp - module subroutine whm_kick_vh_pl(self, system, param, t, dt, lbeg) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters + module subroutine whm_kick_vh_pl(self, nbody_system, param, t, dt, lbeg) implicit none class(whm_pl), intent(inout) :: self !! WHM massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system 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 !! 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 whm_kick_vh_pl - module subroutine whm_kick_vh_tp(self, system, param, t, dt, lbeg) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters + module subroutine whm_kick_vh_tp(self, nbody_system, param, t, dt, lbeg) implicit none class(whm_tp), intent(inout) :: self !! WHM test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system 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 !! Current time real(DP), intent(in) :: dt !! Stepsize @@ -166,84 +145,74 @@ module subroutine whm_kick_vh_tp(self, system, param, t, dt, lbeg) end subroutine whm_kick_vh_tp pure module subroutine whm_gr_kick_getacch_pl(self, param) - use swiftest_classes, only : swiftest_cb, swiftest_parameters implicit none class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine whm_gr_kick_getacch_pl pure module subroutine whm_gr_kick_getacch_tp(self, param) - use swiftest_classes, only : swiftest_cb, swiftest_parameters implicit none class(whm_tp), intent(inout) :: self !! WHM test particle data structure class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine whm_gr_kick_getacch_tp - pure module subroutine whm_gr_p4_pl(self, system, param, dt) - use swiftest_classes, only : swiftest_parameters + pure module subroutine whm_gr_p4_pl(self, nbody_system, param, dt) implicit none class(whm_pl), intent(inout) :: self !! WHM massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size end subroutine whm_gr_p4_pl - pure module subroutine whm_gr_p4_tp(self, system, param, dt) - use swiftest_classes, only : swiftest_parameters + pure module subroutine whm_gr_p4_tp(self, nbody_system, param, dt) implicit none class(whm_tp), intent(inout) :: self !! WHM test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size end subroutine whm_gr_p4_tp !> Reads WHM massive body object in from file - module subroutine whm_setup_pl(self, n, param) - use swiftest_classes, only : swiftest_parameters + module subroutine whm_util_setup_pl(self, n, param) implicit none class(whm_pl), intent(inout) :: self !! WHM massive body objectobject integer(I4B), intent(in) :: n !! Number of particles to allocate space for class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine whm_setup_pl + end subroutine whm_util_setup_pl - module subroutine whm_setup_initialize_system(self, param) - use swiftest_classes, only : swiftest_parameters + module subroutine whm_util_setup_initialize_system(self, param) implicit none class(whm_nbody_system), intent(inout) :: self !! WHM nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine whm_setup_initialize_system + end subroutine whm_util_setup_initialize_system - module subroutine whm_step_pl(self, system, param, t, dt) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters + module subroutine whm_step_pl(self, nbody_system, param, t, dt) implicit none class(whm_pl), intent(inout) :: self !! WHM massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest system 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 whm_step_pl module subroutine whm_step_system(self, param, t, dt) - use swiftest_classes, only : swiftest_parameters implicit none - class(whm_nbody_system), intent(inout) :: self !! WHM system object + class(whm_nbody_system), intent(inout) :: self !! WHM 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 whm_step_system - module subroutine whm_step_tp(self, system, param, t, dt) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters + module subroutine whm_step_tp(self, nbody_system, param, t, dt) implicit none class(whm_tp), intent(inout) :: self !! WHM test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system 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 !! Current simulation time real(DP), intent(in) :: dt !! Stepsize end subroutine whm_step_tp module subroutine whm_util_append_pl(self, source, lsource_mask) - use swiftest_classes, only : swiftest_body implicit none class(whm_pl), intent(inout) :: self !! WHM massive body object class(swiftest_body), intent(in) :: source !! Source object to append @@ -255,32 +224,15 @@ module subroutine whm_util_dealloc_pl(self) class(whm_pl), intent(inout) :: self !! WHM massive body object end subroutine whm_util_dealloc_pl - module subroutine whm_util_final_pl(self) - implicit none - type(whm_pl), intent(inout) :: self !! WHM massive body object - end subroutine whm_util_final_pl - - module subroutine whm_util_final_system(self) - implicit none - type(whm_nbody_system), intent(inout) :: self !! WHM nbody system object - end subroutine whm_util_final_system - - module subroutine whm_util_final_tp(self) - implicit none - type(whm_tp), intent(inout) :: self !! WHM test particle object - end subroutine whm_util_final_tp - module subroutine whm_util_spill_pl(self, discards, lspill_list, ldestructive) - use swiftest_classes, only : swiftest_body implicit none class(whm_pl), intent(inout) :: self !! WHM massive body object - class(swiftest_body), intent(inout) :: discards !! Discarded 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 whm_util_spill_pl module subroutine whm_util_fill_pl(self, inserts, lfill_list) - use swiftest_classes, only : swiftest_body implicit none class(whm_pl), intent(inout) :: self !! WHM massive body object class(swiftest_body), intent(in) :: inserts !! inserted object @@ -299,7 +251,6 @@ module subroutine whm_util_set_ir3j(self) end subroutine whm_util_set_ir3j module subroutine whm_util_set_mu_eta_pl(self, cb) - use swiftest_classes, only : swiftest_cb implicit none class(whm_pl), intent(inout) :: self !! WHM massive body object class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object @@ -319,4 +270,49 @@ module subroutine whm_util_sort_rearrange_pl(self, ind) end subroutine whm_util_sort_rearrange_pl end interface -end module whm_classes + contains + + + + subroutine whm_final_pl(self) + !! author: David A. Minton + !! + !! Finalize the WHM massive body object - deallocates all allocatables + implicit none + ! Argument + type(whm_pl), intent(inout) :: self !! WHM massive body object + + call self%dealloc() + + return + end subroutine whm_final_pl + + + subroutine whm_final_system(self) + !! author: David A. Minton + !! + !! Finalize the WHM nbody system object - deallocates all allocatables + implicit none + ! Arguments + type(whm_nbody_system), intent(inout) :: self !! WHM nbody system object + + call swiftest_final_system(self) + + return + end subroutine whm_final_system + + + subroutine whm_final_tp(self) + !! author: David A. Minton + !! + !! Finalize the WHM test particle object - deallocates all allocatables + implicit none + ! Arguments + type(whm_tp), intent(inout) :: self !! WHM test particle object + + call self%dealloc() + + return + end subroutine whm_final_tp + +end module whm diff --git a/src/whm/whm_setup.f90 b/src/whm/whm_setup.f90 deleted file mode 100644 index 8196a5f77..000000000 --- a/src/whm/whm_setup.f90 +++ /dev/null @@ -1,100 +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. - -submodule(whm_classes) s_whm_setup - use swiftest -contains - - module subroutine whm_setup_pl(self, n, param) - !! author: David A. Minton - !! - !! Allocate WHM planet structure - !! - !! Equivalent in functionality to David E. Kaufmann's Swifter routine whm_setup.f90 - implicit none - ! Arguments - class(whm_pl), 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 parameter - - !> Call allocation method for parent class - call setup_pl(self, n, param) - if (n == 0) return - - allocate(self%eta(n)) - allocate(self%muj(n)) - allocate(self%xj(NDIM, n)) - allocate(self%vj(NDIM, n)) - allocate(self%ir3j(n)) - - self%eta(:) = 0.0_DP - self%muj(:) = 0.0_DP - self%xj(:,:) = 0.0_DP - self%vj(:,:) = 0.0_DP - self%ir3j(:) = 0.0_DP - - return - end subroutine whm_setup_pl - - - module subroutine whm_util_set_mu_eta_pl(self, cb) - !! author: David A. Minton - !! - !! Sets the Jacobi mass value eta for all massive bodies - implicit none - ! Arguments - class(whm_pl), intent(inout) :: self !! WHM system object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - ! Internals - integer(I4B) :: i - - associate(pl => self, npl => self%nbody) - if (npl == 0) return - call util_set_mu_pl(pl, cb) - pl%eta(1) = cb%Gmass + pl%Gmass(1) - pl%muj(1) = pl%eta(1) - do i = 2, npl - pl%eta(i) = pl%eta(i - 1) + pl%Gmass(i) - pl%muj(i) = cb%Gmass * pl%eta(i) / pl%eta(i - 1) - end do - end associate - - return - end subroutine whm_util_set_mu_eta_pl - - - module subroutine whm_setup_initialize_system(self, param) - !! author: David A. Minton - !! - !! Initialize a WHM nbody system from files - !! - implicit none - ! Arguments - class(whm_nbody_system), intent(inout) :: self !! WHM nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - - call setup_initialize_system(self, param) - ! First we need to make sure that the massive bodies are sorted by heliocentric distance before computing jacobies - call util_set_ir3h(self%pl) - call self%pl%sort("ir3h", ascending=.false.) - call self%pl%flatten(param) - - ! Make sure that the discard list gets allocated initially - call self%tp_discards%setup(0, param) - call self%pl%set_mu(self%cb) - call self%tp%set_mu(self%cb) - if (param%lgr .and. ((param%in_type == REAL8_TYPE) .or. (param%in_type == REAL4_TYPE))) then !! pseudovelocity conversion for NetCDF input files is handled by NetCDF routines - call self%pl%v2pv(param) - call self%tp%v2pv(param) - end if - - return - end subroutine whm_setup_initialize_system - -end submodule s_whm_setup \ No newline at end of file diff --git a/src/whm/whm_step.f90 b/src/whm/whm_step.f90 index 9f6b9bea1..e4ea4262d 100644 --- a/src/whm/whm_step.f90 +++ b/src/whm/whm_step.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(whm_classes) s_whm_step +submodule(whm) s_whm_step use swiftest contains @@ -25,17 +25,17 @@ module subroutine whm_step_system(self, param, t, dt) real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Current stepsize - associate(system => self, cb => self%cb, pl => self%pl, tp => self%tp) + associate(nbody_system => self, cb => self%cb, pl => self%pl, tp => self%tp) tp%lfirst = pl%lfirst - call pl%step(system, param, t, dt) - call tp%step(system, param, t, dt) - ! if (param%ltides) call system%step_spin(param, t, dt) + call pl%step(nbody_system, param, t, dt) + call tp%step(nbody_system, param, t, dt) + ! if (param%ltides) call nbody_system%step_spin(param, t, dt) end associate return end subroutine whm_step_system - module subroutine whm_step_pl(self, system, param, t, dt) + module subroutine whm_step_pl(self, nbody_system, param, t, dt) !! author: David A. Minton !! !! Step planets ahead using kick-drift-kick algorithm @@ -46,7 +46,7 @@ module subroutine whm_step_pl(self, system, param, t, dt) implicit none ! Arguments class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest system 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 !! Current simulation time real(DP), intent(in) :: dt !! Current stepsize @@ -55,22 +55,22 @@ module subroutine whm_step_pl(self, system, param, t, dt) if (self%nbody == 0) return - associate(pl => self, cb => system%cb) + associate(pl => self, cb => nbody_system%cb) dth = 0.5_DP * dt - call pl%kick(system, param, t, dth,lbeg=.true.) + call pl%kick(nbody_system, param, t, dth,lbeg=.true.) call pl%vh2vj(cb) - if (param%lgr) call pl%gr_pos_kick(system, param, dth) - call pl%drift(system, param, dt) - if (param%lgr) call pl%gr_pos_kick(system, param, dth) + if (param%lgr) call pl%gr_pos_kick(nbody_system, param, dth) + call pl%drift(nbody_system, param, dt) + if (param%lgr) call pl%gr_pos_kick(nbody_system, param, dth) call pl%j2h(cb) - call pl%kick(system, param, t + dt, dth, lbeg=.false.) + call pl%kick(nbody_system, param, t + dt, dth, lbeg=.false.) end associate return end subroutine whm_step_pl - module subroutine whm_step_tp(self, system, param, t, dt) + module subroutine whm_step_tp(self, nbody_system, param, t, dt) !! author: David A. Minton !! !! Step active test particles ahead using kick-drift-kick algorithm @@ -80,7 +80,7 @@ module subroutine whm_step_tp(self, system, param, t, dt) implicit none ! Arguments class(whm_tp), intent(inout) :: self !! WHM test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest system 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 !! Current simulation time real(DP), intent(in) :: dt !! Current stepsize @@ -89,15 +89,15 @@ module subroutine whm_step_tp(self, system, param, t, dt) if (self%nbody == 0) return - select type(system) + select type(nbody_system) class is (whm_nbody_system) - associate(tp => self, cb => system%cb, pl => system%pl) + associate(tp => self, cb => nbody_system%cb, pl => nbody_system%pl) dth = 0.5_DP * dt - call tp%kick(system, param, t, dth, lbeg=.true.) - if (param%lgr) call tp%gr_pos_kick(system, param, dth) - call tp%drift(system, param, dt) - if (param%lgr) call tp%gr_pos_kick(system, param, dth) - call tp%kick(system, param, t + dt, dth, lbeg=.false.) + call tp%kick(nbody_system, param, t, dth, lbeg=.true.) + if (param%lgr) call tp%gr_pos_kick(nbody_system, param, dth) + call tp%drift(nbody_system, param, dt) + if (param%lgr) call tp%gr_pos_kick(nbody_system, param, dth) + call tp%kick(nbody_system, param, t + dt, dth, lbeg=.false.) end associate end select diff --git a/src/whm/whm_util.f90 b/src/whm/whm_util.f90 index 2143cf0e9..a9377536d 100644 --- a/src/whm/whm_util.f90 +++ b/src/whm/whm_util.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(whm_classes) s_whm_util +submodule(whm) s_whm_util use swiftest contains @@ -25,13 +25,13 @@ module subroutine whm_util_append_pl(self, source, lsource_mask) select type(source) class is (whm_pl) associate(nold => self%nbody, nsrc => source%nbody) - call util_append(self%eta, source%eta, nold, nsrc, lsource_mask) - call util_append(self%muj, source%muj, nold, nsrc, lsource_mask) - call util_append(self%ir3j, source%ir3j, nold, nsrc, lsource_mask) - call util_append(self%xj, source%xj, nold, nsrc, lsource_mask) - call util_append(self%vj, source%vj, nold, nsrc, lsource_mask) + call swiftest_util_append(self%eta, source%eta, nold, nsrc, lsource_mask) + call swiftest_util_append(self%muj, source%muj, nold, nsrc, lsource_mask) + call swiftest_util_append(self%ir3j, source%ir3j, nold, nsrc, lsource_mask) + call swiftest_util_append(self%xj, source%xj, nold, nsrc, lsource_mask) + call swiftest_util_append(self%vj, source%vj, nold, nsrc, lsource_mask) - call util_append_pl(self, source, lsource_mask) + call swiftest_util_append_pl(self, source, lsource_mask) end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class whm_pl or its descendents" @@ -56,7 +56,7 @@ module subroutine whm_util_dealloc_pl(self) if (allocated(self%vj)) deallocate(self%vj) if (allocated(self%ir3j)) deallocate(self%ir3j) - call util_dealloc_pl(self) + call swiftest_util_dealloc_pl(self) return end subroutine whm_util_dealloc_pl @@ -78,13 +78,13 @@ module subroutine whm_util_fill_pl(self, inserts, lfill_list) associate(keeps => self) select type(inserts) class is (whm_pl) - call util_fill(keeps%eta, inserts%eta, lfill_list) - call util_fill(keeps%muj, inserts%muj, lfill_list) - call util_fill(keeps%ir3j, inserts%ir3j, lfill_list) - call util_fill(keeps%xj, inserts%xj, lfill_list) - call util_fill(keeps%vj, inserts%vj, lfill_list) + call swiftest_util_fill(keeps%eta, inserts%eta, lfill_list) + call swiftest_util_fill(keeps%muj, inserts%muj, lfill_list) + call swiftest_util_fill(keeps%ir3j, inserts%ir3j, lfill_list) + call swiftest_util_fill(keeps%xj, inserts%xj, lfill_list) + call swiftest_util_fill(keeps%vj, inserts%vj, lfill_list) - call util_fill_pl(keeps, inserts, lfill_list) + call swiftest_util_fill_pl(keeps, inserts, lfill_list) class default write(*,*) "Invalid object passed to the fill method. Inserts must be of class whm_pl or its descendents!" call util_exit(FAILURE) @@ -95,93 +95,138 @@ module subroutine whm_util_fill_pl(self, inserts, lfill_list) end subroutine whm_util_fill_pl - module subroutine whm_util_final_pl(self) + module subroutine whm_util_resize_pl(self, nnew) !! author: David A. Minton !! - !! Finalize the WHM massive body object - deallocates all allocatables + !! Checks the current size of a massive body against the requested size and resizes it if it is too small. implicit none - ! Argument - type(whm_pl), intent(inout) :: self !! WHM massive body object + ! Arguments + class(whm_pl), intent(inout) :: self !! WHM massive body object + integer(I4B), intent(in) :: nnew !! New size neded + + call swiftest_util_resize(self%eta, nnew) + call swiftest_util_resize(self%xj, nnew) + call swiftest_util_resize(self%vj, nnew) + call swiftest_util_resize(self%muj, nnew) + call swiftest_util_resize(self%ir3j, nnew) - call self%dealloc() + call swiftest_util_resize_pl(self, nnew) return - end subroutine whm_util_final_pl + end subroutine whm_util_resize_pl - module subroutine whm_util_final_system(self) + module subroutine whm_util_set_ir3j(self) !! author: David A. Minton !! - !! Finalize the WHM nbody system object - deallocates all allocatables + !! Sets the inverse Jacobi and heliocentric radii cubed (1/rj**3 and 1/rh**3) implicit none ! Arguments - type(whm_nbody_system), intent(inout) :: self !! WHM nbody system object + class(whm_pl), intent(inout) :: self !! WHM massive body object + ! Internals + integer(I4B) :: i + real(DP) :: r2, ir - call self%dealloc() + if (self%nbody > 0) then + do i = 1, self%nbody + r2 = dot_product(self%rh(:, i), self%rh(:, i)) + ir = 1.0_DP / sqrt(r2) + self%ir3h(i) = ir / r2 + r2 = dot_product(self%xj(:, i), self%xj(:, i)) + ir = 1.0_DP / sqrt(r2) + self%ir3j(i) = ir / r2 + end do + end if return - end subroutine whm_util_final_system + end subroutine whm_util_set_ir3j - module subroutine whm_util_final_tp(self) + module subroutine whm_util_setup_pl(self, n, param) !! author: David A. Minton !! - !! Finalize the WHM test particle object - deallocates all allocatables + !! Allocate WHM planet structure + !! + !! Equivalent in functionality to David E. Kaufmann's Swifter routine whm_util_setup.f90 implicit none ! Arguments - type(whm_tp), intent(inout) :: self !! WHM test particle object - - call self%dealloc() + class(whm_pl), 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 parameter + + !> Call allocation method for parent class + call swiftest_util_setup_pl(self, n, param) + if (n == 0) return + + allocate(self%eta(n)) + allocate(self%muj(n)) + allocate(self%xj(NDIM, n)) + allocate(self%vj(NDIM, n)) + allocate(self%ir3j(n)) + + self%eta(:) = 0.0_DP + self%muj(:) = 0.0_DP + self%xj(:,:) = 0.0_DP + self%vj(:,:) = 0.0_DP + self%ir3j(:) = 0.0_DP return - end subroutine whm_util_final_tp + end subroutine whm_util_setup_pl - module subroutine whm_util_resize_pl(self, nnew) + module subroutine whm_util_set_mu_eta_pl(self, cb) !! author: David A. Minton !! - !! Checks the current size of a massive body against the requested size and resizes it if it is too small. + !! Sets the Jacobi mass value eta for all massive bodies implicit none ! Arguments - class(whm_pl), intent(inout) :: self !! WHM massive body object - integer(I4B), intent(in) :: nnew !! New size neded - - call util_resize(self%eta, nnew) - call util_resize(self%xj, nnew) - call util_resize(self%vj, nnew) - call util_resize(self%muj, nnew) - call util_resize(self%ir3j, nnew) + class(whm_pl), intent(inout) :: self !! WHM nbody_system object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + ! Internals + integer(I4B) :: i - call util_resize_pl(self, nnew) + associate(pl => self, npl => self%nbody) + if (npl == 0) return + call swiftest_util_set_mu_pl(pl, cb) + pl%eta(1) = cb%Gmass + pl%Gmass(1) + pl%muj(1) = pl%eta(1) + do i = 2, npl + pl%eta(i) = pl%eta(i - 1) + pl%Gmass(i) + pl%muj(i) = cb%Gmass * pl%eta(i) / pl%eta(i - 1) + end do + end associate return - end subroutine whm_util_resize_pl + end subroutine whm_util_set_mu_eta_pl - module subroutine whm_util_set_ir3j(self) + module subroutine whm_util_setup_initialize_system(self, param) !! author: David A. Minton !! - !! Sets the inverse Jacobi and heliocentric radii cubed (1/rj**3 and 1/rh**3) + !! Initialize a WHM nbody system from files + !! implicit none ! Arguments - class(whm_pl), intent(inout) :: self !! WHM massive body object - ! Internals - integer(I4B) :: i - real(DP) :: r2, ir - - if (self%nbody > 0) then - do i = 1, self%nbody - r2 = dot_product(self%xh(:, i), self%xh(:, i)) - ir = 1.0_DP / sqrt(r2) - self%ir3h(i) = ir / r2 - r2 = dot_product(self%xj(:, i), self%xj(:, i)) - ir = 1.0_DP / sqrt(r2) - self%ir3j(i) = ir / r2 - end do + class(whm_nbody_system), intent(inout) :: self !! WHM nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + + call swiftest_util_setup_initialize_system(self, param) + ! First we need to make sure that the massive bodies are sorted by heliocentric distance before computing jacobies + call swiftest_util_set_ir3h(self%pl) + call self%pl%sort("ir3h", ascending=.false.) + call self%pl%flatten(param) + + ! Make sure that the discard list gets allocated initially + call self%tp_discards%setup(0, param) + call self%pl%set_mu(self%cb) + call self%tp%set_mu(self%cb) + if (param%lgr .and. param%in_type == "ASCII") then !! pseudovelocity conversion for NetCDF input files is handled by NetCDF routines + call self%pl%v2pv(param) + call self%tp%v2pv(param) end if return - end subroutine whm_util_set_ir3j + end subroutine whm_util_setup_initialize_system module subroutine whm_util_sort_pl(self, sortby, ascending) @@ -209,15 +254,15 @@ module subroutine whm_util_sort_pl(self, sortby, ascending) associate(pl => self, npl => self%nbody) select case(sortby) case("eta") - call util_sort(direction * pl%eta(1:npl), ind) + call swiftest_util_sort(direction * pl%eta(1:npl), ind) case("muj") - call util_sort(direction * pl%muj(1:npl), ind) + call swiftest_util_sort(direction * pl%muj(1:npl), ind) case("ir3j") - call util_sort(direction * pl%ir3j(1:npl), ind) + call swiftest_util_sort(direction * pl%ir3j(1:npl), ind) case("xj", "vj") write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' case default - call util_sort_pl(pl, sortby, ascending) + call swiftest_util_sort_pl(pl, sortby, ascending) return end select @@ -241,13 +286,13 @@ module subroutine whm_util_sort_rearrange_pl(self, ind) if (self%nbody == 0) return associate(pl => self, npl => self%nbody) - call util_sort_rearrange(pl%eta, ind, npl) - call util_sort_rearrange(pl%xj, ind, npl) - call util_sort_rearrange(pl%vj, ind, npl) - call util_sort_rearrange(pl%muj, ind, npl) - call util_sort_rearrange(pl%ir3j, ind, npl) + call swiftest_util_sort_rearrange(pl%eta, ind, npl) + call swiftest_util_sort_rearrange(pl%xj, ind, npl) + call swiftest_util_sort_rearrange(pl%vj, ind, npl) + call swiftest_util_sort_rearrange(pl%muj, ind, npl) + call swiftest_util_sort_rearrange(pl%ir3j, ind, npl) - call util_sort_rearrange_pl(pl,ind) + call swiftest_util_sort_rearrange_pl(pl,ind) end associate return @@ -270,13 +315,13 @@ module subroutine whm_util_spill_pl(self, discards, lspill_list, ldestructive) associate(keeps => self) select type(discards) class is (whm_pl) - call util_spill(keeps%eta, discards%eta, lspill_list, ldestructive) - call util_spill(keeps%muj, discards%muj, lspill_list, ldestructive) - call util_spill(keeps%ir3j, discards%ir3j, lspill_list, ldestructive) - call util_spill(keeps%xj, discards%xj, lspill_list, ldestructive) - call util_spill(keeps%vj, discards%vj, lspill_list, ldestructive) + call swiftest_util_spill(keeps%eta, discards%eta, lspill_list, ldestructive) + call swiftest_util_spill(keeps%muj, discards%muj, lspill_list, ldestructive) + call swiftest_util_spill(keeps%ir3j, discards%ir3j, lspill_list, ldestructive) + call swiftest_util_spill(keeps%xj, discards%xj, lspill_list, ldestructive) + call swiftest_util_spill(keeps%vj, discards%vj, lspill_list, ldestructive) - call util_spill_pl(keeps, discards, lspill_list, ldestructive) + call swiftest_util_spill_pl(keeps, discards, lspill_list, ldestructive) class default write(*,*) "Invalid object passed to the spill method. Source must be of class whm_pl or its descendents!" call util_exit(FAILURE)