diff --git a/examples/Basic_Simulation/initial_conditions.ipynb b/examples/Basic_Simulation/initial_conditions.ipynb index 17b85582f..60581d22a 100644 --- a/examples/Basic_Simulation/initial_conditions.ipynb +++ b/examples/Basic_Simulation/initial_conditions.ipynb @@ -2,18 +2,10 @@ "cells": [ { "cell_type": "code", - "execution_count": 1, + "execution_count": null, "id": "2c4f59ea-1251-49f6-af1e-5695d7e25500", "metadata": {}, - "outputs": [ - { - "name": "stdout", - "output_type": "stream", - "text": [ - "env: OMP_NUM_THREADS=4\n" - ] - } - ], + "outputs": [], "source": [ "import swiftest\n", "import numpy as np\n", @@ -23,468 +15,21 @@ }, { "cell_type": "code", - "execution_count": 2, + "execution_count": null, "id": "6054c7ab-c748-4b39-9fee-d8b27326f497", "metadata": {}, "outputs": [], "source": [ "# Initialize the simulation object as a variable\n", - "sim = swiftest.Simulation(tstart=0.0, tstop=1.0e3, dt=0.01, tstep_out=1.0e0, dump_cadence=2, fragmentation=True, minimum_fragment_mass = 2.5e-11, mtiny=2.5e-8)" + "sim = swiftest.Simulation(fragmentation=True, minimum_fragment_mass = 2.5e-11, mtiny=2.5e-8)" ] }, { "cell_type": "code", - "execution_count": 3, + "execution_count": null, "id": "1c122676-bacb-447c-bc37-5ef8019be0d0", "metadata": {}, - "outputs": [ - { - "name": "stdout", - "output_type": "stream", - "text": [ - "Creating the Sun as a central body\n", - "Fetching ephemerides data for Mercury from JPL/Horizons\n", - "Fetching ephemerides data for Venus from JPL/Horizons\n", - "Fetching ephemerides data for Earth from JPL/Horizons\n", - "Fetching ephemerides data for Mars from JPL/Horizons\n", - "Fetching ephemerides data for Jupiter from JPL/Horizons\n", - "Fetching ephemerides data for Saturn from JPL/Horizons\n", - "Fetching ephemerides data for Uranus from JPL/Horizons\n", - "Fetching ephemerides data for Neptune from JPL/Horizons\n", - "Fetching ephemerides data for Pluto from JPL/Horizons\n" - ] - }, - { - "data": { - "text/html": [ - "
\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "
<xarray.Dataset>\n",
-       "Dimensions:        (name: 10, time: 1)\n",
-       "Coordinates:\n",
-       "  * name           (name) <U32 'Sun' 'Mercury' 'Venus' ... 'Neptune' 'Pluto'\n",
-       "  * time           (time) float64 0.0\n",
-       "Data variables: (12/21)\n",
-       "    particle_type  (name) <U32 'Central Body' 'Massive Body' ... 'Massive Body'\n",
-       "    id             (name) int64 0 1 2 3 4 5 6 7 8 9\n",
-       "    a              (time, name) float64 nan 0.3871 0.7233 ... 19.24 30.04 39.37\n",
-       "    e              (time, name) float64 nan 0.2056 0.006718 ... 0.008956 0.2487\n",
-       "    inc            (time, name) float64 nan 7.003 3.394 ... 0.773 1.771 17.17\n",
-       "    capom          (time, name) float64 nan 48.3 76.6 ... 74.01 131.8 110.3\n",
-       "    ...             ...\n",
-       "    rotz           (time, name) float64 82.25 34.36 8.703 ... 2.33e+03 -38.57\n",
-       "    j2rp2          (time, name) float64 4.754e-12 nan nan nan ... nan nan nan\n",
-       "    j4rp4          (time, name) float64 -2.247e-18 nan nan nan ... nan nan nan\n",
-       "    ntp            (time) int64 0\n",
-       "    npl            (time) int64 9\n",
-       "    nplm           (time) int64 8
" - ], - "text/plain": [ - "\n", - "Dimensions: (name: 10, time: 1)\n", - "Coordinates:\n", - " * name (name) \n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "
<xarray.Dataset>\n",
-       "Dimensions:        (name: 5, time: 1)\n",
-       "Coordinates:\n",
-       "  * name           (name) <U14 'MassiveBody_01' ... 'MassiveBody_05'\n",
-       "  * time           (time) float64 0.0\n",
-       "Data variables: (12/19)\n",
-       "    particle_type  (name) <U14 'Massive Body' 'Massive Body' ... 'Massive Body'\n",
-       "    id             (name) int64 10 11 12 13 14\n",
-       "    a              (time, name) float64 1.469 0.4169 1.369 0.6314 0.4806\n",
-       "    e              (time, name) float64 0.1092 0.03191 0.03574 0.03611 0.2767\n",
-       "    inc            (time, name) float64 0.2741 70.11 62.39 31.73 47.9\n",
-       "    capom          (time, name) float64 123.3 146.2 205.2 41.36 298.9\n",
-       "    ...             ...\n",
-       "    rotx           (time, name) float64 0.0 0.0 0.0 0.0 0.0\n",
-       "    roty           (time, name) float64 0.0 0.0 0.0 0.0 0.0\n",
-       "    rotz           (time, name) float64 0.0 0.0 0.0 0.0 0.0\n",
-       "    ntp            (time) int64 0\n",
-       "    npl            (time) int64 4\n",
-       "    nplm           (time) int64 4
" - ], - "text/plain": [ - "\n", - "Dimensions: (name: 5, time: 1)\n", - "Coordinates:\n", - " * name (name) \n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "
<xarray.Dataset>\n",
-       "Dimensions:        (name: 10, time: 1)\n",
-       "Coordinates:\n",
-       "  * name           (name) <U15 'TestParticle_01' ... 'TestParticle_10'\n",
-       "  * time           (time) float64 0.0\n",
-       "Data variables:\n",
-       "    particle_type  (name) <U15 'Test Particle' ... 'Test Particle'\n",
-       "    id             (name) int64 15 16 17 18 19 20 21 22 23 24\n",
-       "    a              (time, name) float64 0.7527 1.445 0.8756 ... 1.341 0.9409\n",
-       "    e              (time, name) float64 0.267 0.0711 0.04515 ... 0.1502 0.06409\n",
-       "    inc            (time, name) float64 58.34 7.109 33.64 ... 52.18 26.94 7.888\n",
-       "    capom          (time, name) float64 130.7 145.3 68.94 ... 131.8 140.6 81.53\n",
-       "    omega          (time, name) float64 144.5 215.6 104.4 ... 288.9 84.92 180.3\n",
-       "    capm           (time, name) float64 55.73 338.2 71.69 ... 239.2 311.4 187.1\n",
-       "    ntp            int64 10\n",
-       "    npl            int64 0\n",
-       "    nplm           int64 0
" - ], - "text/plain": [ - "\n", - "Dimensions: (name: 10, time: 1)\n", - "Coordinates:\n", - " * name (name) 2\u001b[0m \u001b[43msim\u001b[49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43mrun\u001b[49m\u001b[43m(\u001b[49m\u001b[43m)\u001b[49m\n", - "File \u001b[0;32m~/git_debug/swiftest/python/swiftest/swiftest/simulation_class.py:474\u001b[0m, in \u001b[0;36mSimulation.run\u001b[0;34m(self, **kwargs)\u001b[0m\n\u001b[1;32m 471\u001b[0m \u001b[38;5;28mself\u001b[39m\u001b[38;5;241m.\u001b[39m_run_swiftest_driver()\n\u001b[1;32m 473\u001b[0m \u001b[38;5;66;03m# Read in new data\u001b[39;00m\n\u001b[0;32m--> 474\u001b[0m \u001b[38;5;28;43mself\u001b[39;49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43mbin2xr\u001b[49m\u001b[43m(\u001b[49m\u001b[43m)\u001b[49m\n\u001b[1;32m 476\u001b[0m \u001b[38;5;28;01mreturn\u001b[39;00m\n", - "File \u001b[0;32m~/git_debug/swiftest/python/swiftest/swiftest/simulation_class.py:2743\u001b[0m, in \u001b[0;36mSimulation.bin2xr\u001b[0;34m(self)\u001b[0m\n\u001b[1;32m 2741\u001b[0m param_tmp[\u001b[38;5;124m'\u001b[39m\u001b[38;5;124mBIN_OUT\u001b[39m\u001b[38;5;124m'\u001b[39m] \u001b[38;5;241m=\u001b[39m os\u001b[38;5;241m.\u001b[39mpath\u001b[38;5;241m.\u001b[39mjoin(\u001b[38;5;28mself\u001b[39m\u001b[38;5;241m.\u001b[39msim_dir, \u001b[38;5;28mself\u001b[39m\u001b[38;5;241m.\u001b[39mparam[\u001b[38;5;124m'\u001b[39m\u001b[38;5;124mBIN_OUT\u001b[39m\u001b[38;5;124m'\u001b[39m])\n\u001b[1;32m 2742\u001b[0m \u001b[38;5;28;01mif\u001b[39;00m \u001b[38;5;28mself\u001b[39m\u001b[38;5;241m.\u001b[39mcodename \u001b[38;5;241m==\u001b[39m \u001b[38;5;124m\"\u001b[39m\u001b[38;5;124mSwiftest\u001b[39m\u001b[38;5;124m\"\u001b[39m:\n\u001b[0;32m-> 2743\u001b[0m \u001b[38;5;28mself\u001b[39m\u001b[38;5;241m.\u001b[39mdata \u001b[38;5;241m=\u001b[39m \u001b[43mio\u001b[49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43mswiftest2xr\u001b[49m\u001b[43m(\u001b[49m\u001b[43mparam_tmp\u001b[49m\u001b[43m,\u001b[49m\u001b[43m \u001b[49m\u001b[43mverbose\u001b[49m\u001b[38;5;241;43m=\u001b[39;49m\u001b[38;5;28;43mself\u001b[39;49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43mverbose\u001b[49m\u001b[43m)\u001b[49m\n\u001b[1;32m 2744\u001b[0m \u001b[38;5;28;01mif\u001b[39;00m \u001b[38;5;28mself\u001b[39m\u001b[38;5;241m.\u001b[39mverbose: \u001b[38;5;28mprint\u001b[39m(\u001b[38;5;124m'\u001b[39m\u001b[38;5;124mSwiftest simulation data stored as xarray DataSet .data\u001b[39m\u001b[38;5;124m'\u001b[39m)\n\u001b[1;32m 2745\u001b[0m \u001b[38;5;28;01melif\u001b[39;00m \u001b[38;5;28mself\u001b[39m\u001b[38;5;241m.\u001b[39mcodename \u001b[38;5;241m==\u001b[39m \u001b[38;5;124m\"\u001b[39m\u001b[38;5;124mSwifter\u001b[39m\u001b[38;5;124m\"\u001b[39m:\n", - "File \u001b[0;32m~/git_debug/swiftest/python/swiftest/swiftest/io.py:854\u001b[0m, in \u001b[0;36mswiftest2xr\u001b[0;34m(param, verbose)\u001b[0m\n\u001b[1;32m 852\u001b[0m \u001b[38;5;28;01mif\u001b[39;00m ((param[\u001b[38;5;124m'\u001b[39m\u001b[38;5;124mOUT_TYPE\u001b[39m\u001b[38;5;124m'\u001b[39m] \u001b[38;5;241m==\u001b[39m \u001b[38;5;124m'\u001b[39m\u001b[38;5;124mNETCDF_DOUBLE\u001b[39m\u001b[38;5;124m'\u001b[39m) \u001b[38;5;129;01mor\u001b[39;00m (param[\u001b[38;5;124m'\u001b[39m\u001b[38;5;124mOUT_TYPE\u001b[39m\u001b[38;5;124m'\u001b[39m] \u001b[38;5;241m==\u001b[39m \u001b[38;5;124m'\u001b[39m\u001b[38;5;124mNETCDF_FLOAT\u001b[39m\u001b[38;5;124m'\u001b[39m)):\n\u001b[1;32m 853\u001b[0m \u001b[38;5;28;01mif\u001b[39;00m verbose: \u001b[38;5;28mprint\u001b[39m(\u001b[38;5;124m'\u001b[39m\u001b[38;5;130;01m\\n\u001b[39;00m\u001b[38;5;124mCreating Dataset from NetCDF file\u001b[39m\u001b[38;5;124m'\u001b[39m)\n\u001b[0;32m--> 854\u001b[0m ds \u001b[38;5;241m=\u001b[39m \u001b[43mxr\u001b[49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43mopen_dataset\u001b[49m\u001b[43m(\u001b[49m\u001b[43mparam\u001b[49m\u001b[43m[\u001b[49m\u001b[38;5;124;43m'\u001b[39;49m\u001b[38;5;124;43mBIN_OUT\u001b[39;49m\u001b[38;5;124;43m'\u001b[39;49m\u001b[43m]\u001b[49m\u001b[43m,\u001b[49m\u001b[43m \u001b[49m\u001b[43mmask_and_scale\u001b[49m\u001b[38;5;241;43m=\u001b[39;49m\u001b[38;5;28;43;01mFalse\u001b[39;49;00m\u001b[43m)\u001b[49m\n\u001b[1;32m 855\u001b[0m \u001b[38;5;28;01mif\u001b[39;00m param[\u001b[38;5;124m'\u001b[39m\u001b[38;5;124mOUT_TYPE\u001b[39m\u001b[38;5;124m'\u001b[39m] \u001b[38;5;241m==\u001b[39m \u001b[38;5;124m\"\u001b[39m\u001b[38;5;124mNETCDF_DOUBLE\u001b[39m\u001b[38;5;124m\"\u001b[39m:\n\u001b[1;32m 856\u001b[0m ds \u001b[38;5;241m=\u001b[39m fix_types(ds,ftype\u001b[38;5;241m=\u001b[39mnp\u001b[38;5;241m.\u001b[39mfloat64)\n", - "File \u001b[0;32m~/.conda/envs/cent7/2020.11-py38/debug_env/lib/python3.8/site-packages/xarray/backends/api.py:495\u001b[0m, in \u001b[0;36mopen_dataset\u001b[0;34m(filename_or_obj, engine, chunks, cache, decode_cf, mask_and_scale, decode_times, decode_timedelta, use_cftime, concat_characters, decode_coords, drop_variables, backend_kwargs, *args, **kwargs)\u001b[0m\n\u001b[1;32m 483\u001b[0m decoders \u001b[38;5;241m=\u001b[39m _resolve_decoders_kwargs(\n\u001b[1;32m 484\u001b[0m decode_cf,\n\u001b[1;32m 485\u001b[0m open_backend_dataset_parameters\u001b[38;5;241m=\u001b[39mbackend\u001b[38;5;241m.\u001b[39mopen_dataset_parameters,\n\u001b[0;32m (...)\u001b[0m\n\u001b[1;32m 491\u001b[0m decode_coords\u001b[38;5;241m=\u001b[39mdecode_coords,\n\u001b[1;32m 492\u001b[0m )\n\u001b[1;32m 494\u001b[0m overwrite_encoded_chunks \u001b[38;5;241m=\u001b[39m kwargs\u001b[38;5;241m.\u001b[39mpop(\u001b[38;5;124m\"\u001b[39m\u001b[38;5;124moverwrite_encoded_chunks\u001b[39m\u001b[38;5;124m\"\u001b[39m, \u001b[38;5;28;01mNone\u001b[39;00m)\n\u001b[0;32m--> 495\u001b[0m backend_ds \u001b[38;5;241m=\u001b[39m \u001b[43mbackend\u001b[49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43mopen_dataset\u001b[49m\u001b[43m(\u001b[49m\n\u001b[1;32m 496\u001b[0m \u001b[43m \u001b[49m\u001b[43mfilename_or_obj\u001b[49m\u001b[43m,\u001b[49m\n\u001b[1;32m 497\u001b[0m \u001b[43m \u001b[49m\u001b[43mdrop_variables\u001b[49m\u001b[38;5;241;43m=\u001b[39;49m\u001b[43mdrop_variables\u001b[49m\u001b[43m,\u001b[49m\n\u001b[1;32m 498\u001b[0m \u001b[43m \u001b[49m\u001b[38;5;241;43m*\u001b[39;49m\u001b[38;5;241;43m*\u001b[39;49m\u001b[43mdecoders\u001b[49m\u001b[43m,\u001b[49m\n\u001b[1;32m 499\u001b[0m \u001b[43m \u001b[49m\u001b[38;5;241;43m*\u001b[39;49m\u001b[38;5;241;43m*\u001b[39;49m\u001b[43mkwargs\u001b[49m\u001b[43m,\u001b[49m\n\u001b[1;32m 500\u001b[0m \u001b[43m\u001b[49m\u001b[43m)\u001b[49m\n\u001b[1;32m 501\u001b[0m ds \u001b[38;5;241m=\u001b[39m _dataset_from_backend_dataset(\n\u001b[1;32m 502\u001b[0m backend_ds,\n\u001b[1;32m 503\u001b[0m filename_or_obj,\n\u001b[0;32m (...)\u001b[0m\n\u001b[1;32m 510\u001b[0m \u001b[38;5;241m*\u001b[39m\u001b[38;5;241m*\u001b[39mkwargs,\n\u001b[1;32m 511\u001b[0m )\n\u001b[1;32m 512\u001b[0m \u001b[38;5;28;01mreturn\u001b[39;00m ds\n", - "File \u001b[0;32m~/.conda/envs/cent7/2020.11-py38/debug_env/lib/python3.8/site-packages/xarray/backends/h5netcdf_.py:386\u001b[0m, in \u001b[0;36mH5netcdfBackendEntrypoint.open_dataset\u001b[0;34m(self, filename_or_obj, mask_and_scale, decode_times, concat_characters, decode_coords, drop_variables, use_cftime, decode_timedelta, format, group, lock, invalid_netcdf, phony_dims, decode_vlen_strings)\u001b[0m\n\u001b[1;32m 374\u001b[0m store \u001b[38;5;241m=\u001b[39m H5NetCDFStore\u001b[38;5;241m.\u001b[39mopen(\n\u001b[1;32m 375\u001b[0m filename_or_obj,\n\u001b[1;32m 376\u001b[0m \u001b[38;5;28mformat\u001b[39m\u001b[38;5;241m=\u001b[39m\u001b[38;5;28mformat\u001b[39m,\n\u001b[0;32m (...)\u001b[0m\n\u001b[1;32m 381\u001b[0m decode_vlen_strings\u001b[38;5;241m=\u001b[39mdecode_vlen_strings,\n\u001b[1;32m 382\u001b[0m )\n\u001b[1;32m 384\u001b[0m store_entrypoint \u001b[38;5;241m=\u001b[39m StoreBackendEntrypoint()\n\u001b[0;32m--> 386\u001b[0m ds \u001b[38;5;241m=\u001b[39m \u001b[43mstore_entrypoint\u001b[49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43mopen_dataset\u001b[49m\u001b[43m(\u001b[49m\n\u001b[1;32m 387\u001b[0m \u001b[43m \u001b[49m\u001b[43mstore\u001b[49m\u001b[43m,\u001b[49m\n\u001b[1;32m 388\u001b[0m \u001b[43m \u001b[49m\u001b[43mmask_and_scale\u001b[49m\u001b[38;5;241;43m=\u001b[39;49m\u001b[43mmask_and_scale\u001b[49m\u001b[43m,\u001b[49m\n\u001b[1;32m 389\u001b[0m \u001b[43m \u001b[49m\u001b[43mdecode_times\u001b[49m\u001b[38;5;241;43m=\u001b[39;49m\u001b[43mdecode_times\u001b[49m\u001b[43m,\u001b[49m\n\u001b[1;32m 390\u001b[0m \u001b[43m \u001b[49m\u001b[43mconcat_characters\u001b[49m\u001b[38;5;241;43m=\u001b[39;49m\u001b[43mconcat_characters\u001b[49m\u001b[43m,\u001b[49m\n\u001b[1;32m 391\u001b[0m \u001b[43m \u001b[49m\u001b[43mdecode_coords\u001b[49m\u001b[38;5;241;43m=\u001b[39;49m\u001b[43mdecode_coords\u001b[49m\u001b[43m,\u001b[49m\n\u001b[1;32m 392\u001b[0m \u001b[43m \u001b[49m\u001b[43mdrop_variables\u001b[49m\u001b[38;5;241;43m=\u001b[39;49m\u001b[43mdrop_variables\u001b[49m\u001b[43m,\u001b[49m\n\u001b[1;32m 393\u001b[0m \u001b[43m \u001b[49m\u001b[43muse_cftime\u001b[49m\u001b[38;5;241;43m=\u001b[39;49m\u001b[43muse_cftime\u001b[49m\u001b[43m,\u001b[49m\n\u001b[1;32m 394\u001b[0m \u001b[43m \u001b[49m\u001b[43mdecode_timedelta\u001b[49m\u001b[38;5;241;43m=\u001b[39;49m\u001b[43mdecode_timedelta\u001b[49m\u001b[43m,\u001b[49m\n\u001b[1;32m 395\u001b[0m \u001b[43m\u001b[49m\u001b[43m)\u001b[49m\n\u001b[1;32m 396\u001b[0m \u001b[38;5;28;01mreturn\u001b[39;00m ds\n", - "File \u001b[0;32m~/.conda/envs/cent7/2020.11-py38/debug_env/lib/python3.8/site-packages/xarray/backends/store.py:24\u001b[0m, in \u001b[0;36mStoreBackendEntrypoint.open_dataset\u001b[0;34m(self, store, mask_and_scale, decode_times, concat_characters, decode_coords, drop_variables, use_cftime, decode_timedelta)\u001b[0m\n\u001b[1;32m 12\u001b[0m \u001b[38;5;28;01mdef\u001b[39;00m \u001b[38;5;21mopen_dataset\u001b[39m(\n\u001b[1;32m 13\u001b[0m \u001b[38;5;28mself\u001b[39m,\n\u001b[1;32m 14\u001b[0m store,\n\u001b[0;32m (...)\u001b[0m\n\u001b[1;32m 22\u001b[0m decode_timedelta\u001b[38;5;241m=\u001b[39m\u001b[38;5;28;01mNone\u001b[39;00m,\n\u001b[1;32m 23\u001b[0m ):\n\u001b[0;32m---> 24\u001b[0m \u001b[38;5;28mvars\u001b[39m, attrs \u001b[38;5;241m=\u001b[39m \u001b[43mstore\u001b[49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43mload\u001b[49m\u001b[43m(\u001b[49m\u001b[43m)\u001b[49m\n\u001b[1;32m 25\u001b[0m encoding \u001b[38;5;241m=\u001b[39m store\u001b[38;5;241m.\u001b[39mget_encoding()\n\u001b[1;32m 27\u001b[0m \u001b[38;5;28mvars\u001b[39m, attrs, coord_names \u001b[38;5;241m=\u001b[39m conventions\u001b[38;5;241m.\u001b[39mdecode_cf_variables(\n\u001b[1;32m 28\u001b[0m \u001b[38;5;28mvars\u001b[39m,\n\u001b[1;32m 29\u001b[0m attrs,\n\u001b[0;32m (...)\u001b[0m\n\u001b[1;32m 36\u001b[0m decode_timedelta\u001b[38;5;241m=\u001b[39mdecode_timedelta,\n\u001b[1;32m 37\u001b[0m )\n", - "File \u001b[0;32m~/.conda/envs/cent7/2020.11-py38/debug_env/lib/python3.8/site-packages/xarray/backends/common.py:123\u001b[0m, in \u001b[0;36mAbstractDataStore.load\u001b[0;34m(self)\u001b[0m\n\u001b[1;32m 101\u001b[0m \u001b[38;5;28;01mdef\u001b[39;00m \u001b[38;5;21mload\u001b[39m(\u001b[38;5;28mself\u001b[39m):\n\u001b[1;32m 102\u001b[0m \u001b[38;5;124;03m\"\"\"\u001b[39;00m\n\u001b[1;32m 103\u001b[0m \u001b[38;5;124;03m This loads the variables and attributes simultaneously.\u001b[39;00m\n\u001b[1;32m 104\u001b[0m \u001b[38;5;124;03m A centralized loading function makes it easier to create\u001b[39;00m\n\u001b[0;32m (...)\u001b[0m\n\u001b[1;32m 120\u001b[0m \u001b[38;5;124;03m are requested, so care should be taken to make sure its fast.\u001b[39;00m\n\u001b[1;32m 121\u001b[0m \u001b[38;5;124;03m \"\"\"\u001b[39;00m\n\u001b[1;32m 122\u001b[0m variables \u001b[38;5;241m=\u001b[39m FrozenDict(\n\u001b[0;32m--> 123\u001b[0m (_decode_variable_name(k), v) \u001b[38;5;28;01mfor\u001b[39;00m k, v \u001b[38;5;129;01min\u001b[39;00m \u001b[38;5;28;43mself\u001b[39;49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43mget_variables\u001b[49m\u001b[43m(\u001b[49m\u001b[43m)\u001b[49m\u001b[38;5;241m.\u001b[39mitems()\n\u001b[1;32m 124\u001b[0m )\n\u001b[1;32m 125\u001b[0m attributes \u001b[38;5;241m=\u001b[39m FrozenDict(\u001b[38;5;28mself\u001b[39m\u001b[38;5;241m.\u001b[39mget_attrs())\n\u001b[1;32m 126\u001b[0m \u001b[38;5;28;01mreturn\u001b[39;00m variables, attributes\n", - "File \u001b[0;32m~/.conda/envs/cent7/2020.11-py38/debug_env/lib/python3.8/site-packages/xarray/backends/h5netcdf_.py:229\u001b[0m, in \u001b[0;36mH5NetCDFStore.get_variables\u001b[0;34m(self)\u001b[0m\n\u001b[1;32m 228\u001b[0m \u001b[38;5;28;01mdef\u001b[39;00m \u001b[38;5;21mget_variables\u001b[39m(\u001b[38;5;28mself\u001b[39m):\n\u001b[0;32m--> 229\u001b[0m \u001b[38;5;28;01mreturn\u001b[39;00m \u001b[43mFrozenDict\u001b[49m\u001b[43m(\u001b[49m\n\u001b[1;32m 230\u001b[0m \u001b[43m \u001b[49m\u001b[43m(\u001b[49m\u001b[43mk\u001b[49m\u001b[43m,\u001b[49m\u001b[43m \u001b[49m\u001b[38;5;28;43mself\u001b[39;49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43mopen_store_variable\u001b[49m\u001b[43m(\u001b[49m\u001b[43mk\u001b[49m\u001b[43m,\u001b[49m\u001b[43m \u001b[49m\u001b[43mv\u001b[49m\u001b[43m)\u001b[49m\u001b[43m)\u001b[49m\u001b[43m \u001b[49m\u001b[38;5;28;43;01mfor\u001b[39;49;00m\u001b[43m \u001b[49m\u001b[43mk\u001b[49m\u001b[43m,\u001b[49m\u001b[43m \u001b[49m\u001b[43mv\u001b[49m\u001b[43m \u001b[49m\u001b[38;5;129;43;01min\u001b[39;49;00m\u001b[43m \u001b[49m\u001b[38;5;28;43mself\u001b[39;49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43mds\u001b[49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43mvariables\u001b[49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43mitems\u001b[49m\u001b[43m(\u001b[49m\u001b[43m)\u001b[49m\n\u001b[1;32m 231\u001b[0m \u001b[43m \u001b[49m\u001b[43m)\u001b[49m\n", - "File \u001b[0;32m~/.conda/envs/cent7/2020.11-py38/debug_env/lib/python3.8/site-packages/xarray/core/utils.py:476\u001b[0m, in \u001b[0;36mFrozenDict\u001b[0;34m(*args, **kwargs)\u001b[0m\n\u001b[1;32m 475\u001b[0m \u001b[38;5;28;01mdef\u001b[39;00m \u001b[38;5;21mFrozenDict\u001b[39m(\u001b[38;5;241m*\u001b[39margs, \u001b[38;5;241m*\u001b[39m\u001b[38;5;241m*\u001b[39mkwargs) \u001b[38;5;241m-\u001b[39m\u001b[38;5;241m>\u001b[39m Frozen:\n\u001b[0;32m--> 476\u001b[0m \u001b[38;5;28;01mreturn\u001b[39;00m Frozen(\u001b[38;5;28;43mdict\u001b[39;49m\u001b[43m(\u001b[49m\u001b[38;5;241;43m*\u001b[39;49m\u001b[43margs\u001b[49m\u001b[43m,\u001b[49m\u001b[43m \u001b[49m\u001b[38;5;241;43m*\u001b[39;49m\u001b[38;5;241;43m*\u001b[39;49m\u001b[43mkwargs\u001b[49m\u001b[43m)\u001b[49m)\n", - "File \u001b[0;32m~/.conda/envs/cent7/2020.11-py38/debug_env/lib/python3.8/site-packages/xarray/backends/h5netcdf_.py:230\u001b[0m, in \u001b[0;36m\u001b[0;34m(.0)\u001b[0m\n\u001b[1;32m 228\u001b[0m \u001b[38;5;28;01mdef\u001b[39;00m \u001b[38;5;21mget_variables\u001b[39m(\u001b[38;5;28mself\u001b[39m):\n\u001b[1;32m 229\u001b[0m \u001b[38;5;28;01mreturn\u001b[39;00m FrozenDict(\n\u001b[0;32m--> 230\u001b[0m (k, \u001b[38;5;28;43mself\u001b[39;49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43mopen_store_variable\u001b[49m\u001b[43m(\u001b[49m\u001b[43mk\u001b[49m\u001b[43m,\u001b[49m\u001b[43m \u001b[49m\u001b[43mv\u001b[49m\u001b[43m)\u001b[49m) \u001b[38;5;28;01mfor\u001b[39;00m k, v \u001b[38;5;129;01min\u001b[39;00m \u001b[38;5;28mself\u001b[39m\u001b[38;5;241m.\u001b[39mds\u001b[38;5;241m.\u001b[39mvariables\u001b[38;5;241m.\u001b[39mitems()\n\u001b[1;32m 231\u001b[0m )\n", - "File \u001b[0;32m~/.conda/envs/cent7/2020.11-py38/debug_env/lib/python3.8/site-packages/xarray/backends/h5netcdf_.py:195\u001b[0m, in \u001b[0;36mH5NetCDFStore.open_store_variable\u001b[0;34m(self, name, var)\u001b[0m\n\u001b[1;32m 192\u001b[0m \u001b[38;5;28;01mimport\u001b[39;00m \u001b[38;5;21;01mh5py\u001b[39;00m\n\u001b[1;32m 194\u001b[0m dimensions \u001b[38;5;241m=\u001b[39m var\u001b[38;5;241m.\u001b[39mdimensions\n\u001b[0;32m--> 195\u001b[0m data \u001b[38;5;241m=\u001b[39m indexing\u001b[38;5;241m.\u001b[39mLazilyIndexedArray(\u001b[43mH5NetCDFArrayWrapper\u001b[49m\u001b[43m(\u001b[49m\u001b[43mname\u001b[49m\u001b[43m,\u001b[49m\u001b[43m \u001b[49m\u001b[38;5;28;43mself\u001b[39;49m\u001b[43m)\u001b[49m)\n\u001b[1;32m 196\u001b[0m attrs \u001b[38;5;241m=\u001b[39m _read_attributes(var)\n\u001b[1;32m 198\u001b[0m \u001b[38;5;66;03m# netCDF4 specific encoding\u001b[39;00m\n", - "File \u001b[0;32m~/.conda/envs/cent7/2020.11-py38/debug_env/lib/python3.8/site-packages/xarray/backends/netCDF4_.py:56\u001b[0m, in \u001b[0;36mBaseNetCDF4Array.__init__\u001b[0;34m(self, variable_name, datastore)\u001b[0m\n\u001b[1;32m 53\u001b[0m \u001b[38;5;28mself\u001b[39m\u001b[38;5;241m.\u001b[39mvariable_name \u001b[38;5;241m=\u001b[39m variable_name\n\u001b[1;32m 55\u001b[0m array \u001b[38;5;241m=\u001b[39m \u001b[38;5;28mself\u001b[39m\u001b[38;5;241m.\u001b[39mget_array()\n\u001b[0;32m---> 56\u001b[0m \u001b[38;5;28mself\u001b[39m\u001b[38;5;241m.\u001b[39mshape \u001b[38;5;241m=\u001b[39m \u001b[43marray\u001b[49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43mshape\u001b[49m\n\u001b[1;32m 58\u001b[0m dtype \u001b[38;5;241m=\u001b[39m array\u001b[38;5;241m.\u001b[39mdtype\n\u001b[1;32m 59\u001b[0m \u001b[38;5;28;01mif\u001b[39;00m dtype \u001b[38;5;129;01mis\u001b[39;00m \u001b[38;5;28mstr\u001b[39m:\n\u001b[1;32m 60\u001b[0m \u001b[38;5;66;03m# use object dtype because that's the only way in numpy to\u001b[39;00m\n\u001b[1;32m 61\u001b[0m \u001b[38;5;66;03m# represent variable length strings; it also prevents automatic\u001b[39;00m\n\u001b[1;32m 62\u001b[0m \u001b[38;5;66;03m# string concatenation via conventions.decode_cf_variable\u001b[39;00m\n", - "File \u001b[0;32m~/.conda/envs/cent7/2020.11-py38/debug_env/lib/python3.8/site-packages/h5netcdf/core.py:259\u001b[0m, in \u001b[0;36mBaseVariable.shape\u001b[0;34m(self)\u001b[0m\n\u001b[1;32m 257\u001b[0m \u001b[38;5;124;03m\"\"\"Return current sizes of all variable dimensions.\"\"\"\u001b[39;00m\n\u001b[1;32m 258\u001b[0m \u001b[38;5;66;03m# return actual dimensions sizes, this is in line with netcdf4-python\u001b[39;00m\n\u001b[0;32m--> 259\u001b[0m \u001b[38;5;28;01mreturn\u001b[39;00m \u001b[38;5;28mtuple\u001b[39m([\u001b[38;5;28mself\u001b[39m\u001b[38;5;241m.\u001b[39m_parent\u001b[38;5;241m.\u001b[39m_all_dimensions[d]\u001b[38;5;241m.\u001b[39msize \u001b[38;5;28;01mfor\u001b[39;00m d \u001b[38;5;129;01min\u001b[39;00m \u001b[38;5;28mself\u001b[39m\u001b[38;5;241m.\u001b[39mdimensions])\n", - "File \u001b[0;32m~/.conda/envs/cent7/2020.11-py38/debug_env/lib/python3.8/site-packages/h5netcdf/core.py:259\u001b[0m, in \u001b[0;36m\u001b[0;34m(.0)\u001b[0m\n\u001b[1;32m 257\u001b[0m \u001b[38;5;124;03m\"\"\"Return current sizes of all variable dimensions.\"\"\"\u001b[39;00m\n\u001b[1;32m 258\u001b[0m \u001b[38;5;66;03m# return actual dimensions sizes, this is in line with netcdf4-python\u001b[39;00m\n\u001b[0;32m--> 259\u001b[0m \u001b[38;5;28;01mreturn\u001b[39;00m \u001b[38;5;28mtuple\u001b[39m([\u001b[38;5;28;43mself\u001b[39;49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43m_parent\u001b[49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43m_all_dimensions\u001b[49m\u001b[43m[\u001b[49m\u001b[43md\u001b[49m\u001b[43m]\u001b[49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43msize\u001b[49m \u001b[38;5;28;01mfor\u001b[39;00m d \u001b[38;5;129;01min\u001b[39;00m \u001b[38;5;28mself\u001b[39m\u001b[38;5;241m.\u001b[39mdimensions])\n", - "File \u001b[0;32m~/.conda/envs/cent7/2020.11-py38/debug_env/lib/python3.8/site-packages/h5netcdf/dimensions.py:115\u001b[0m, in \u001b[0;36mDimension.size\u001b[0;34m(self)\u001b[0m\n\u001b[1;32m 113\u001b[0m \u001b[38;5;28;01mif\u001b[39;00m reflist \u001b[38;5;129;01mis\u001b[39;00m \u001b[38;5;129;01mnot\u001b[39;00m \u001b[38;5;28;01mNone\u001b[39;00m:\n\u001b[1;32m 114\u001b[0m \u001b[38;5;28;01mfor\u001b[39;00m ref, axis \u001b[38;5;129;01min\u001b[39;00m reflist:\n\u001b[0;32m--> 115\u001b[0m var \u001b[38;5;241m=\u001b[39m \u001b[38;5;28;43mself\u001b[39;49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43m_parent\u001b[49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43m_h5group\u001b[49m\u001b[43m[\u001b[49m\u001b[38;5;124;43m\"\u001b[39;49m\u001b[38;5;124;43m/\u001b[39;49m\u001b[38;5;124;43m\"\u001b[39;49m\u001b[43m]\u001b[49m\u001b[43m[\u001b[49m\u001b[43mref\u001b[49m\u001b[43m]\u001b[49m\n\u001b[1;32m 116\u001b[0m size \u001b[38;5;241m=\u001b[39m \u001b[38;5;28mmax\u001b[39m(var\u001b[38;5;241m.\u001b[39mshape[axis], size)\n\u001b[1;32m 117\u001b[0m \u001b[38;5;28;01mreturn\u001b[39;00m size\n", - "File \u001b[0;32mh5py/_objects.pyx:54\u001b[0m, in \u001b[0;36mh5py._objects.with_phil.wrapper\u001b[0;34m()\u001b[0m\n", - "File \u001b[0;32mh5py/_objects.pyx:55\u001b[0m, in \u001b[0;36mh5py._objects.with_phil.wrapper\u001b[0;34m()\u001b[0m\n", - "File \u001b[0;32m~/.conda/envs/cent7/2020.11-py38/debug_env/lib/python3.8/site-packages/h5py/_hl/group.py:337\u001b[0m, in \u001b[0;36mGroup.__getitem__\u001b[0;34m(self, name)\u001b[0m\n\u001b[1;32m 335\u001b[0m \u001b[38;5;28;01mreturn\u001b[39;00m Group(oid)\n\u001b[1;32m 336\u001b[0m \u001b[38;5;28;01melif\u001b[39;00m otype \u001b[38;5;241m==\u001b[39m h5i\u001b[38;5;241m.\u001b[39mDATASET:\n\u001b[0;32m--> 337\u001b[0m \u001b[38;5;28;01mreturn\u001b[39;00m \u001b[43mdataset\u001b[49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43mDataset\u001b[49m\u001b[43m(\u001b[49m\u001b[43moid\u001b[49m\u001b[43m,\u001b[49m\u001b[43m \u001b[49m\u001b[43mreadonly\u001b[49m\u001b[38;5;241;43m=\u001b[39;49m\u001b[43m(\u001b[49m\u001b[38;5;28;43mself\u001b[39;49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43mfile\u001b[49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43mmode\u001b[49m\u001b[43m \u001b[49m\u001b[38;5;241;43m==\u001b[39;49m\u001b[43m \u001b[49m\u001b[38;5;124;43m'\u001b[39;49m\u001b[38;5;124;43mr\u001b[39;49m\u001b[38;5;124;43m'\u001b[39;49m\u001b[43m)\u001b[49m\u001b[43m)\u001b[49m\n\u001b[1;32m 338\u001b[0m \u001b[38;5;28;01melif\u001b[39;00m otype \u001b[38;5;241m==\u001b[39m h5i\u001b[38;5;241m.\u001b[39mDATATYPE:\n\u001b[1;32m 339\u001b[0m \u001b[38;5;28;01mreturn\u001b[39;00m datatype\u001b[38;5;241m.\u001b[39mDatatype(oid)\n", - "File \u001b[0;32mh5py/_objects.pyx:54\u001b[0m, in \u001b[0;36mh5py._objects.with_phil.wrapper\u001b[0;34m()\u001b[0m\n", - "File \u001b[0;32mh5py/_objects.pyx:55\u001b[0m, in \u001b[0;36mh5py._objects.with_phil.wrapper\u001b[0;34m()\u001b[0m\n", - "File \u001b[0;32m~/.conda/envs/cent7/2020.11-py38/debug_env/lib/python3.8/site-packages/h5py/_hl/dataset.py:622\u001b[0m, in \u001b[0;36mDataset.__init__\u001b[0;34m(self, bind, readonly)\u001b[0m\n\u001b[1;32m 619\u001b[0m \u001b[38;5;28;01mraise\u001b[39;00m \u001b[38;5;167;01mValueError\u001b[39;00m(\u001b[38;5;124m\"\u001b[39m\u001b[38;5;132;01m%s\u001b[39;00m\u001b[38;5;124m is not a DatasetID\u001b[39m\u001b[38;5;124m\"\u001b[39m \u001b[38;5;241m%\u001b[39m bind)\n\u001b[1;32m 620\u001b[0m \u001b[38;5;28msuper\u001b[39m()\u001b[38;5;241m.\u001b[39m\u001b[38;5;21m__init__\u001b[39m(bind)\n\u001b[0;32m--> 622\u001b[0m \u001b[38;5;28mself\u001b[39m\u001b[38;5;241m.\u001b[39m_dcpl \u001b[38;5;241m=\u001b[39m \u001b[38;5;28;43mself\u001b[39;49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43mid\u001b[49m\u001b[38;5;241;43m.\u001b[39;49m\u001b[43mget_create_plist\u001b[49m\u001b[43m(\u001b[49m\u001b[43m)\u001b[49m\n\u001b[1;32m 623\u001b[0m \u001b[38;5;28mself\u001b[39m\u001b[38;5;241m.\u001b[39m_dxpl \u001b[38;5;241m=\u001b[39m h5p\u001b[38;5;241m.\u001b[39mcreate(h5p\u001b[38;5;241m.\u001b[39mDATASET_XFER)\n\u001b[1;32m 624\u001b[0m \u001b[38;5;28mself\u001b[39m\u001b[38;5;241m.\u001b[39m_filters \u001b[38;5;241m=\u001b[39m filters\u001b[38;5;241m.\u001b[39mget_filters(\u001b[38;5;28mself\u001b[39m\u001b[38;5;241m.\u001b[39m_dcpl)\n", - "\u001b[0;31mKeyboardInterrupt\u001b[0m: " - ] - } - ], + "outputs": [], "source": [ "# Run the simulation\n", - "sim.run()" + "sim.run(tstart=0.0, tstop=1.0e3, dt=0.01, tstep_out=1.0e0, dump_cadence=0)" ] }, { @@ -1582,6 +143,26 @@ "id": "02a8911d-3b2c-415c-9290-bf1519a3f5c6", "metadata": {}, "outputs": [], + "source": [ + "sim.ic" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "id": "5f8d1ac3-5ad0-4b8a-ad9d-1b63486920aa", + "metadata": {}, + "outputs": [], + "source": [ + "sim.data" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "id": "fb93805d-377b-47d6-a565-c26acd2a7cbc", + "metadata": {}, + "outputs": [], "source": [] } ], diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index 4d7fe7ae5..7e0218a03 100644 --- a/examples/Basic_Simulation/initial_conditions.py +++ b/examples/Basic_Simulation/initial_conditions.py @@ -23,7 +23,7 @@ from numpy.random import default_rng # Initialize the simulation object as a variable -sim = swiftest.Simulation(tstart=0.0, tstop=1.0e3, dt=0.01, tstep_out=1.0e0, dump_cadence=0, fragmentation=True, minimum_fragment_mass = 2.5e-11, mtiny=2.5e-8) +sim = swiftest.Simulation(fragmentation=True, minimum_fragment_mass = 2.5e-11, mtiny=2.5e-8) # 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"]) @@ -42,14 +42,10 @@ 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) -Ip1_pl = [0.4, 0.4, 0.4, 0.4, 0.4] -Ip2_pl = [0.4, 0.4, 0.4, 0.4, 0.4] -Ip3_pl = [0.4, 0.4, 0.4, 0.4, 0.4] -rotx_pl = [0.0, 0.0, 0.0, 0.0, 0.0] -roty_pl = [0.0, 0.0, 0.0, 0.0, 0.0] -rotz_pl = [0.0, 0.0, 0.0, 0.0, 0.0] +Ip_pl = np.full((npl,3),0.4,) +rot_pl = np.zeros((npl,3)) -sim.add_body(name=name_pl, v1=a_pl, v2=e_pl, v3=inc_pl, v4=capom_pl, v5=omega_pl, v6=capm_pl, Gmass=GM_pl, radius=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 ntp = 10 @@ -62,9 +58,9 @@ omega_tp = default_rng().uniform(0.0, 360.0, ntp) capm_tp = default_rng().uniform(0.0, 360.0, ntp) -sim.add_body(name=name_tp, v1=a_tp, v2=e_tp, v3=inc_tp, v4=capom_tp, v5=omega_tp, v6=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.get_parameter() # Run the simulation -sim.run() +sim.run(tstart=0.0, tstop=1.0e3, dt=0.01, tstep_out=1.0e0, dump_cadence=0) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 4759594d5..24fc40e30 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -188,13 +188,13 @@ def data_stream(self, frame=0): if run_new: sim = swiftest.Simulation(param_file=param_file, rotation=True, init_cond_format = "XV", compute_conservation_values=True) sim.add_solar_system_body("Sun") - sim.add_body(Gmass=body_Gmass[style], radius=body_radius[style], xh=pos_vectors[style], vh=vel_vectors[style], rot=rot_vectors[style]) + sim.add_body(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(fragmentation = True, gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) - sim.run(dt=1e-8, tstop=2.e-5) + sim.run(dt=2e-5, tstop=2.e-5) else: sim = swiftest.Simulation(param_file=param_file, read_old_output_file=True) diff --git a/examples/helio_gr_test/grsim/param.gr.in b/examples/helio_gr_test/grsim/param.gr.in deleted file mode 100644 index 0616db203..000000000 --- a/examples/helio_gr_test/grsim/param.gr.in +++ /dev/null @@ -1,35 +0,0 @@ -! VERSION Swiftest input file -T0 0.0 -TSTART 0.0 -TSTOP 1000.0 -DT 0.005 -ISTEP_OUT 2000 -ISTEP_DUMP 2000 -NC_IN init_cond.nc -IN_TYPE NETCDF_DOUBLE -IN_FORM EL -BIN_OUT bin.gr.nc -OUT_FORM XVEL -OUT_TYPE NETCDF_DOUBLE -OUT_STAT REPLACE -CHK_QMIN 0.004650467260962157 -CHK_RMIN 0.004650467260962157 -CHK_RMAX 10000.0 -CHK_EJECT 10000.0 -CHK_QMIN_COORD HELIO -CHK_QMIN_RANGE 0.004650467260962157 10000.0 -MU2KG 1.988409870698051e+30 -TU2S 31557600.0 -DU2M 149597870700.0 -FRAGMENTATION NO -RESTART NO -CHK_CLOSE YES -GR YES -ROTATION NO -ENERGY NO -EXTRA_FORCE NO -BIG_DISCARD NO -RHILL_PRESENT NO -INTERACTION_LOOPS TRIANGULAR -ENCOUNTER_CHECK TRIANGULAR -TIDES NO diff --git a/examples/helio_gr_test/swiftest_relativity.ipynb b/examples/helio_gr_test/helio_gr_test.ipynb similarity index 79% rename from examples/helio_gr_test/swiftest_relativity.ipynb rename to examples/helio_gr_test/helio_gr_test.ipynb index 4b6d13106..c6b0c67ea 100644 --- a/examples/helio_gr_test/swiftest_relativity.ipynb +++ b/examples/helio_gr_test/helio_gr_test.ipynb @@ -19,7 +19,7 @@ "metadata": {}, "outputs": [], "source": [ - "sim_gr = swiftest.Simulation(param_file=\"grsim/param.gr.in\", output_file_name=\"bin.gr.nc\")\n", + "sim_gr = swiftest.Simulation(simdir=\"gr\")\n", "sim_gr.add_solar_system_body([\"Sun\",\"Mercury\",\"Venus\",\"Earth\",\"Mars\",\"Jupiter\",\"Saturn\",\"Uranus\",\"Neptune\"])" ] }, @@ -29,7 +29,7 @@ "metadata": {}, "outputs": [], "source": [ - "sim_nogr = swiftest.Simulation(param_file=\"nogrsim/param.nogr.in\", output_file_name=\"bin.nogr.nc\")\n", + "sim_nogr = swiftest.Simulation(simdir=\"nogr\")\n", "sim_nogr.add_solar_system_body([\"Sun\",\"Mercury\",\"Venus\",\"Earth\",\"Mars\",\"Jupiter\",\"Saturn\",\"Uranus\",\"Neptune\"])" ] }, @@ -39,8 +39,7 @@ "metadata": {}, "outputs": [], "source": [ - "tstep_out = 10.0\n", - "sim_gr.run(tstop=1000.0, dt=0.005, tstep_out=tstep_out, integrator=\"helio\",general_relativity=True)" + "run_args = {\"tstop\":1000.0, \"dt\":0.005, \"tstep_out\":10.0, \"dump_cadence\": 0,\"integrator\":\"helio\"}" ] }, { @@ -49,7 +48,16 @@ "metadata": {}, "outputs": [], "source": [ - "sim_nogr.run(tstop=1000.0, dt=0.005, tstep_out=tstep_out, integrator=\"helio\",general_relativity=False)" + "sim_gr.run(**run_args,general_relativity=True)" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "metadata": {}, + "outputs": [], + "source": [ + "sim_nogr.run(**run_args,general_relativity=False)" ] }, { @@ -80,17 +88,6 @@ "varpi_obs = el['w'] + el['Omega']" ] }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "# Compute the longitude of the periapsis\n", - "sim_gr.data['varpi'] = np.mod(sim_gr.data['omega'] + sim_gr.data['capom'],360)\n", - "sim_nogr.data['varpi'] = np.mod(sim_nogr.data['omega'] + sim_nogr.data['capom'],360)" - ] - }, { "cell_type": "code", "execution_count": null, @@ -108,8 +105,8 @@ "metadata": {}, "outputs": [], "source": [ - "dvarpi_gr = np.diff(varpisim_gr) * 3600 * 100 / tstep_out\n", - "dvarpi_nogr = np.diff(varpisim_nogr) * 3600 * 100 / tstep_out\n", + "dvarpi_gr = np.diff(varpisim_gr) * 3600 * 100 / run_args['tstep_out']\n", + "dvarpi_nogr = np.diff(varpisim_nogr) * 3600 * 100 / run_args['tstep_out']\n", "dvarpi_obs = np.diff(varpi_obs) / np.diff(t) * 3600 * 100" ] }, @@ -135,20 +132,13 @@ "print(f'Obs - Swiftest GR : {np.mean(dvarpi_obs - dvarpi_gr)}')\n", "print(f'Obs - Swiftest No GR : {np.mean(dvarpi_obs - dvarpi_nogr)}')" ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [] } ], "metadata": { "kernelspec": { - "display_name": "swiftest", + "display_name": "Python (My debug_env Kernel)", "language": "python", - "name": "swiftest" + "name": "debug_env" }, "language_info": { "codemirror_mode": { diff --git a/examples/helio_gr_test/swiftest_relativity.py b/examples/helio_gr_test/helio_gr_test.py similarity index 72% rename from examples/helio_gr_test/swiftest_relativity.py rename to examples/helio_gr_test/helio_gr_test.py index a5f4e4371..0d9339dbe 100644 --- a/examples/helio_gr_test/swiftest_relativity.py +++ b/examples/helio_gr_test/helio_gr_test.py @@ -5,15 +5,16 @@ import numpy as np import matplotlib.pyplot as plt -sim_gr = swiftest.Simulation(param_file="param.gr.in", output_file_name="bin.gr.nc") +sim_gr = swiftest.Simulation(simdir="gr") sim_gr.add_solar_system_body(["Sun","Mercury","Venus","Earth","Mars","Jupiter","Saturn","Uranus","Neptune"]) -sim_nogr = swiftest.Simulation(param_file="param.nogr.in", output_file_name="bin.nogr.nc") +sim_nogr = swiftest.Simulation(simdir="nogr") sim_nogr.add_solar_system_body(["Sun","Mercury","Venus","Earth","Mars","Jupiter","Saturn","Uranus","Neptune"]) -tstep_out = 10.0 -sim_gr.run(tstop=1000.0, dt=0.005, tstep_out=tstep_out, integrator="helio",general_relativity=True) -sim_nogr.run(tstop=1000.0, dt=0.005, tstep_out=tstep_out, integrator="helio",general_relativity=False) +run_args = {"tstop":1000.0, "dt":0.005, "tstep_out":10.0, "dump_cadence": 0,"integrator":"helio"} + +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 @@ -29,19 +30,14 @@ t = (el['datetime_jd']-el['datetime_jd'][0]) / 365.25 varpi_obs = el['w'] + el['Omega'] -# Compute the longitude of the periapsis -sim_gr.data['varpi'] = np.mod(sim_gr.data['omega'] + sim_gr.data['capom'],360) -sim_nogr.data['varpi'] = np.mod(sim_nogr.data['omega'] + sim_nogr.data['capom'],360) - 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 / tstep_out -dvarpi_nogr = np.diff(varpisim_nogr) * 3600 * 100 / tstep_out +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 - fig, ax = plt.subplots() ax.plot(t, varpi_obs, label="JPL Horizons",linewidth=2.5) diff --git a/examples/helio_gr_test/nogrsim/param.nogr.in b/examples/helio_gr_test/nogrsim/param.nogr.in deleted file mode 100644 index 9e2ab0b22..000000000 --- a/examples/helio_gr_test/nogrsim/param.nogr.in +++ /dev/null @@ -1,35 +0,0 @@ -! VERSION Swiftest input file -T0 0.0 -TSTART 0.0 -TSTOP 1000.0 -DT 0.005 -ISTEP_OUT 2000 -ISTEP_DUMP 2000 -NC_IN init_cond.nc -IN_TYPE NETCDF_DOUBLE -IN_FORM EL -BIN_OUT bin.nogr.nc -OUT_FORM XVEL -OUT_TYPE NETCDF_DOUBLE -OUT_STAT REPLACE -CHK_QMIN 0.004650467260962157 -CHK_RMIN 0.004650467260962157 -CHK_RMAX 10000.0 -CHK_EJECT 10000.0 -CHK_QMIN_COORD HELIO -CHK_QMIN_RANGE 0.004650467260962157 10000.0 -MU2KG 1.988409870698051e+30 -TU2S 31557600.0 -DU2M 149597870700.0 -FRAGMENTATION NO -RESTART NO -CHK_CLOSE YES -GR NO -ROTATION NO -ENERGY NO -EXTRA_FORCE NO -BIG_DISCARD NO -RHILL_PRESENT NO -INTERACTION_LOOPS TRIANGULAR -ENCOUNTER_CHECK TRIANGULAR -TIDES NO diff --git a/examples/whm_gr_test/swiftest_relativity.ipynb b/examples/whm_gr_test/swiftest_relativity.ipynb deleted file mode 100644 index 0e5f26360..000000000 --- a/examples/whm_gr_test/swiftest_relativity.ipynb +++ /dev/null @@ -1,1051 +0,0 @@ -{ - "cells": [ - { - "cell_type": "code", - "execution_count": 1, - "metadata": {}, - "outputs": [], - "source": [ - "import swiftest\n", - "from astroquery.jplhorizons import Horizons\n", - "import datetime\n", - "import numpy as np\n", - "import matplotlib.pyplot as plt" - ] - }, - { - "cell_type": "code", - "execution_count": 2, - "metadata": {}, - "outputs": [ - { - "name": "stdout", - "output_type": "stream", - "text": [ - "Creating the Sun as a central body\n", - "Fetching ephemerides data for Mercury from JPL/Horizons\n", - "Fetching ephemerides data for Venus from JPL/Horizons\n", - "Fetching ephemerides data for Earth from JPL/Horizons\n", - "Fetching ephemerides data for Mars from JPL/Horizons\n", - "Fetching ephemerides data for Jupiter from JPL/Horizons\n", - "Fetching ephemerides data for Saturn from JPL/Horizons\n", - "Fetching ephemerides data for Uranus from JPL/Horizons\n", - "Fetching ephemerides data for Neptune from JPL/Horizons\n" - ] - }, - { - "data": { - "text/html": [ - "
\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "
<xarray.Dataset>\n",
-       "Dimensions:        (name: 9, time: 1)\n",
-       "Coordinates:\n",
-       "  * name           (name) <U32 'Sun' 'Mercury' 'Venus' ... 'Uranus' 'Neptune'\n",
-       "  * time           (time) float64 0.0\n",
-       "Data variables: (12/15)\n",
-       "    particle_type  (name) <U32 'Central Body' 'Massive Body' ... 'Massive Body'\n",
-       "    id             (name) int64 0 1 2 3 4 5 6 7 8\n",
-       "    a              (time, name) float64 nan 0.3871 0.7233 ... 9.532 19.24 30.04\n",
-       "    e              (time, name) float64 nan 0.2056 0.006718 ... 0.04796 0.008956\n",
-       "    inc            (time, name) float64 nan 7.003 3.394 ... 2.488 0.773 1.771\n",
-       "    capom          (time, name) float64 nan 48.3 76.6 ... 113.6 74.01 131.8\n",
-       "    ...             ...\n",
-       "    radius         (time, name) float64 0.00465 1.631e-05 ... 0.0001646\n",
-       "    j2rp2          (time, name) float64 4.754e-12 nan nan nan ... nan nan nan\n",
-       "    j4rp4          (time, name) float64 -2.247e-18 nan nan nan ... nan nan nan\n",
-       "    ntp            (time) int64 0\n",
-       "    npl            (time) int64 8\n",
-       "    nplm           (time) int64 8
" - ], - "text/plain": [ - "\n", - "Dimensions: (name: 9, time: 1)\n", - "Coordinates:\n", - " * name (name) \n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "
<xarray.Dataset>\n",
-       "Dimensions:        (name: 9, time: 1)\n",
-       "Coordinates:\n",
-       "  * name           (name) <U32 'Sun' 'Mercury' 'Venus' ... 'Uranus' 'Neptune'\n",
-       "  * time           (time) float64 0.0\n",
-       "Data variables: (12/15)\n",
-       "    particle_type  (name) <U32 'Central Body' 'Massive Body' ... 'Massive Body'\n",
-       "    id             (name) int64 0 1 2 3 4 5 6 7 8\n",
-       "    a              (time, name) float64 nan 0.3871 0.7233 ... 9.532 19.24 30.04\n",
-       "    e              (time, name) float64 nan 0.2056 0.006718 ... 0.04796 0.008956\n",
-       "    inc            (time, name) float64 nan 7.003 3.394 ... 2.488 0.773 1.771\n",
-       "    capom          (time, name) float64 nan 48.3 76.6 ... 113.6 74.01 131.8\n",
-       "    ...             ...\n",
-       "    radius         (time, name) float64 0.00465 1.631e-05 ... 0.0001646\n",
-       "    j2rp2          (time, name) float64 4.754e-12 nan nan nan ... nan nan nan\n",
-       "    j4rp4          (time, name) float64 -2.247e-18 nan nan nan ... nan nan nan\n",
-       "    ntp            (time) int64 0\n",
-       "    npl            (time) int64 8\n",
-       "    nplm           (time) int64 8
" - ], - "text/plain": [ - "\n", - "Dimensions: (name: 9, time: 1)\n", - "Coordinates:\n", - " * name (name) " + 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 """ + scalar_dims = ['id'] + vector_dims = ['id','space'] + space_coords = np.array(["x","y","z"]) + + 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 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 "rot" not in kwargs and "Gmass" in kwargs: + warnings.warn("Rotation vectors must be given when rotation is enabled for massive bodies",stacklevel=2) + return + if "Ip" not in kwargs and "rot" in kwargs: + kwargs['Ip'] = np.full_like(rot, 0.4) - # The central body is always given id 0 - if GMpl is not None: - icb = (~np.isnan(GMpl)) & (idvals == 0) - ipl = (~np.isnan(GMpl)) & (idvals != 0) - itp = (np.isnan(GMpl)) & (idvals != 0) - iscb = any(icb) - ispl = any(ipl) - istp = any(itp) - else: - icb = np.full_like(idvals,False) - ipl = np.full_like(idvals,False) - itp = idvals != 0 - iscb = False - ispl = False - istp = any(itp) + if "time" not in kwargs: + kwargs["time"] = np.array([0.0]) - if ispl and param['CHK_CLOSE'] and Rpl is None: - print("Massive bodies need a radius value.") - return None - if ispl and rhill is None and param['RHILL_PRESENT']: - 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 - particle_type = np.empty_like(namevals) - vec = np.vstack([v1,v2,v3,v4,v5,v6]) + valid_arguments = vector_vars + scalar_vars + ['time','id'] - if iscb: - lab_cb = clab.copy() - vec_cb = np.vstack([GMpl[icb],Rpl[icb],J2[icb],J4[icb]]) - if param['ROTATION']: - vec_cb = np.vstack([vec_cb, Ip1[icb], Ip2[icb], Ip3[icb], rotx[icb], roty[icb], rotz[icb]]) - particle_type[icb] = "Central Body" - vec_cb = np.expand_dims(vec_cb.T,axis=0) # Make way for the time dimension! - ds_cb = xr.DataArray(vec_cb, dims=dims, coords={'time': [t], 'id': idvals[icb], 'vec': lab_cb}).to_dataset(dim='vec') - else: - ds_cb = None - if ispl: - lab_pl = plab.copy() - vec_pl = np.vstack([vec[:,ipl], GMpl[ipl]]) - if param['CHK_CLOSE']: - vec_pl = np.vstack([vec_pl, Rpl[ipl]]) - if param['RHILL_PRESENT']: - vec_pl = np.vstack([vec_pl, rhill[ipl]]) - if param['ROTATION']: - vec_pl = np.vstack([vec_pl, Ip1[ipl], Ip2[ipl], Ip3[ipl], rotx[ipl], roty[ipl], rotz[ipl]]) - particle_type[ipl] = np.repeat("Massive Body",idvals[ipl].size) - vec_pl = np.expand_dims(vec_pl.T,axis=0) # Make way for the time dimension! - ds_pl = xr.DataArray(vec_pl, dims=dims, coords={'time': [t], 'id': idvals[ipl], 'vec': lab_pl}).to_dataset(dim='vec') - else: - ds_pl = None - if istp: - lab_tp = tlab.copy() - vec_tp = np.expand_dims(vec[:,itp].T,axis=0) # Make way for the time dimension! - ds_tp = xr.DataArray(vec_tp, dims=dims, coords={'time': [t], 'id': idvals[itp], 'vec': lab_tp}).to_dataset(dim='vec') - particle_type[itp] = np.repeat("Test Particle",idvals[itp].size) - else: - ds_tp = None + kwargs = {k:v for k,v in kwargs.items() if k in valid_arguments} - ds_info = xr.DataArray(np.vstack([namevals,particle_type]).T, dims=infodims, coords={'id': idvals, 'vec' : ["name", "particle_type"]}).to_dataset(dim='vec') - ds = [d for d in [ds_cb, ds_pl, ds_tp] if d is not None] - if len(ds) > 1: - ds = xr.combine_by_coords(ds) - else: - ds = ds[0] - ds = xr.merge([ds_info,ds]) + 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']}) return ds \ No newline at end of file diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 92eeec73e..dbcb7430d 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -56,6 +56,7 @@ # 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"] +char_varnames = ["space"] int_varnames = ["id", "ntp", "npl", "nplm", "discard_body_id", "collision_id"] def bool2yesno(boolval): @@ -192,7 +193,19 @@ def read_swiftest_param(param_file_name, param, verbose=True): 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 @@ -516,9 +529,9 @@ 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('rhx') + tlab.append('rhy') + tlab.append('rhz') tlab.append('vhx') tlab.append('vhy') tlab.append('vhz') @@ -564,9 +577,9 @@ 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('rhx') + tlab.append('rhy') + tlab.append('rhz') tlab.append('vhx') tlab.append('vhy') tlab.append('vhz') @@ -606,16 +619,16 @@ def make_swiftest_labels(param): infolab_float = [ "origin_time", - "origin_xhx", - "origin_xhy", - "origin_xhz", + "origin_rhx", + "origin_rhy", + "origin_rhz", "origin_vhx", "origin_vhy", "origin_vhz", "discard_time", - "discard_xhx", - "discard_xhy", - "discard_xhz", + "discard_rhx", + "discard_rhy", + "discard_rhz", "discard_vhx", "discard_vhy", "discard_vhz", @@ -805,7 +818,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: @@ -834,7 +847,6 @@ def swifter2xr(param, verbose=True): if verbose: print(f"Successfully converted {ds.sizes['time']} output frames.") return ds - def swiftest2xr(param, verbose=True): """ Converts a Swiftest binary data file into an xarray DataSet. @@ -889,7 +901,7 @@ def string_converter(da): Parameters ---------- da : xarray dataset - + Returns ------- da : xarray dataset with the strings cleaned up @@ -900,6 +912,24 @@ def string_converter(da): da = xstrip(da) return da +def char_converter(da): + """ + Converts a string to a unicode string + + Parameters + ---------- + da : xarray dataset + + Returns + ------- + da : xarray dataset with the strings cleaned up + """ + if da.dtype == np.dtype(object): + da = da.astype('*Note.* Currently only the JPL Horizons ephemeris is implemented, so this is ignored. Returns ------- - data : Xarray dataset with body or bodies added. + None + initial conditions data stored as an Xarray Dataset in the init_cond instance variable """ if type(name) is str: @@ -2081,71 +2089,43 @@ def add_solar_system_body(self, body_list = [] for i,n in enumerate(name): - body_list.append(init_cond.solar_system_horizons(n, self.param, date, idval=ephemeris_id[i])) + 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: - name,v1,v2,v3,v4,v5,v6,ephemeris_id,Gmass,radius,rhill,Ip1,Ip2,Ip3,rotx,roty,rotz,J2,J4 = tuple(np.hsplit(np.array(body_list[0]),19)) + values = list(np.hsplit(np.array(body_list[0],dtype=np.dtype(object)),17)) else: - name,v1,v2,v3,v4,v5,v6,ephemeris_id,Gmass,radius,rhill,Ip1,Ip2,Ip3,rotx,roty,rotz,J2,J4 = tuple(np.squeeze(np.hsplit(np.array(body_list),19))) - - ephemeris_id = ephemeris_id.astype(int) - v1 = v1.astype(np.float64) - v2 = v2.astype(np.float64) - v3 = v3.astype(np.float64) - v4 = v4.astype(np.float64) - v5 = v5.astype(np.float64) - v6 = v6.astype(np.float64) - rhill = rhill.astype(np.float64) - J2 = J2.astype(np.float64) - J4 = J4.astype(np.float64) - - Gmass = Gmass.astype(np.float64) - radius = radius.astype(np.float64) - Ip1 = Ip1.astype(np.float64) - Ip2 = Ip2.astype(np.float64) - Ip3 = Ip3.astype(np.float64) - rotx = rotx.astype(np.float64) - roty = roty.astype(np.float64) - rotz = rotz.astype(np.float64) - - - if all(np.isnan(Gmass)): - Gmass = None - if all(np.isnan(radius)): - radius = None - if all(np.isnan(rhill)): - rhill = None - if all(np.isnan(Ip1)): - Ip1 = None - if all(np.isnan(Ip2)): - Ip2 = None - if all(np.isnan(Ip3)): - Ip3 = None - if all(np.isnan(rotx)): - rotx = None - if all(np.isnan(roty)): - roty = None - if all(np.isnan(rotz)): - rotz = None - if all(np.isnan(J2)): - J2 = None - if all(np.isnan(J4)): - J4 = None - - t = self.param['TSTART'] - - dsnew = init_cond.vec2xr(self.param,name,v1,v2,v3,v4,v5,v6,ephemeris_id, - GMpl=Gmass, Rpl=radius, rhill=rhill, - Ip1=Ip1, Ip2=Ip2, Ip3=Ip3, - rotx=rotx, roty=roty, rotz=rotz, - J2=J2, J4=J4, t=t) + 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) - return dsnew + self.ic = self.data.copy(deep=True) + + return def set_ephemeris_date(self, @@ -2272,27 +2252,21 @@ def _get_instance_var(self, arg_list: str | List[str], valid_arg: Dict, verbose: def add_body(self, name: str | List[str] | npt.NDArray[np.str_] | None=None, - idvals: int | list[int] | npt.NDArray[np.int_] | None=None, - v1: float | List[float] | npt.NDArray[np.float_] | None = None, - v2: float | List[float] | npt.NDArray[np.float_] | None = None, - v3: float | List[float] | npt.NDArray[np.float_] | None = None, - v4: float | List[float] | npt.NDArray[np.float_] | None = None, - v5: float | List[float] | npt.NDArray[np.float_] | None = None, - v6: float | List[float] | npt.NDArray[np.float_] | None = None, - xh: List[float] | List[npt.NDArray[np.float_]] | npt.NDArray[np.float_] | 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, - Ip1: float | List[float] | npt.NDArray[np.float_] | None=None, - Ip2: float | List[float] | npt.NDArray[np.float_] | None=None, - Ip3: float | List[float] | npt.NDArray[np.float_] | None=None, - Ip: List[float] | npt.NDArray[np.float_] | None=None, - rotx: float | List[float] | npt.NDArray[np.float_] | None=None, - roty: float | List[float] | npt.NDArray[np.float_] | None=None, - rotz: 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): """ @@ -2305,22 +2279,22 @@ def add_body(self, ---------- name : str or array-like of str, optional Name or names of Bodies. If none passed, name will be "Body" - idvals : int or array-like of int, optional + 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. - v1 : float or array-like of float, optional - xhx for param['IN_FORM'] == "XV"; a for param['IN_FORM'] == "EL" - v2 : float or array-like of float, optional - xhy for param['IN_FORM'] == "XV"; e for param['IN_FORM'] == "EL" - v3 : float or array-like of float, optional - xhz for param['IN_FORM'] == "XV"; inc for param['IN_FORM'] == "EL" - v4 : float or array-like of float, optional - vhx for param['IN_FORM'] == "XV"; capom for param['IN_FORM'] == "EL" - v5 : float or array-like of float, optional - vhy for param['IN_FORM'] == "XV"; omega for param['IN_FORM'] == "EL" - v6 : float or array-like of float, optional - vhz for param['IN_FORM'] == "XV"; capm for param['IN_FORM'] == "EL" - xh : (n,3) array-like of float, optional + 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 @@ -2332,10 +2306,6 @@ def add_body(self, Radius values if these are massive bodies rhill : float or array-like of float, optional Hill's radius values if these are massive bodies - Ip<1,2,3> : float or array-like of float, optional - Principal axes moments of inertia if these are massive bodies with rotation enabled - rot: float or array-like of float, optional - Rotation rate vector components if these are massive bodies with rotation enabled rot: (3) or (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 rotx, roty, and rotz separately @@ -2404,27 +2374,21 @@ def input_to_array_3d(val,n=None): nbodies = None name,nbodies = input_to_array(name,"s",nbodies) - v1,nbodies = input_to_array(v1,"f",nbodies) - v2,nbodies = input_to_array(v2,"f",nbodies) - v3,nbodies = input_to_array(v3,"f",nbodies) - v4,nbodies = input_to_array(v4,"f",nbodies) - v5,nbodies = input_to_array(v5,"f",nbodies) - v6,nbodies = input_to_array(v6,"f",nbodies) - idvals,nbodies = input_to_array(idvals,"i",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) - Ip1,nbodies = input_to_array(Ip1,"f",nbodies) - Ip2,nbodies = input_to_array(Ip2,"f",nbodies) - Ip3,nbodies = input_to_array(Ip3,"f",nbodies) - rotx,nbodies = input_to_array(rotx,"f",nbodies) - roty,nbodies = input_to_array(roty,"f",nbodies) - rotz,nbodies = input_to_array(rotz,"f",nbodies) J2,nbodies = input_to_array(J2,"f",nbodies) J4,nbodies = input_to_array(J4,"f",nbodies) - xh,nbodies = input_to_array_3d(xh,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) @@ -2434,50 +2398,18 @@ def input_to_array_3d(val,n=None): else: maxid = self.data.id.max().values[()] - if idvals is None: - idvals = np.arange(start=maxid+1,stop=maxid+1+nbodies,dtype=int) + 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",idvals) + name=np.char.mod(f"Body%d",id) if len(self.data) > 0: - dup_id = np.in1d(idvals, self.data.id) + dup_id = np.in1d(id, self.data.id) if any(dup_id): - raise ValueError(f"Duplicate ids detected: ", *idvals[dup_id]) + raise ValueError(f"Duplicate ids detected: ", *id[dup_id]) - t = self.param['TSTART'] - - if xh is not None: - if v1 is not None or v2 is not None or v3 is not None: - raise ValueError("Cannot use xh and v1,v2,v3 inputs simultaneously!") - else: - v1 = xh.T[0] - v2 = xh.T[1] - v3 = xh.T[2] - - if vh is not None: - if v4 is not None or v5 is not None or v6 is not None: - raise ValueError("Cannot use vh and v4,v5,v6 inputs simultaneously!") - else: - v4 = vh.T[0] - v5 = vh.T[1] - v6 = vh.T[2] - - if rot is not None: - if rotx is not None or roty is not None or rotz is not None: - raise ValueError("Cannot use rot and rotx,roty,rotz inputs simultaneously!") - else: - rotx = rot.T[0] - roty = rot.T[1] - rotz = rot.T[2] - - if Ip is not None: - if Ip1 is not None or Ip2 is not None or Ip3 is not None: - raise ValueError("Cannot use Ip and Ip1,Ip2,Ip3 inputs simultaneously!") - else: - Ip1 = Ip.T[0] - Ip2 = Ip.T[1] - Ip3 = Ip.T[2] + time = [self.param['TSTART']] if mass is not None: if Gmass is not None: @@ -2485,16 +2417,14 @@ def input_to_array_3d(val,n=None): else: Gmass = self.param['GU'] * mass - dsnew = init_cond.vec2xr(self.param, name, v1, v2, v3, v4, v5, v6, idvals, - GMpl=Gmass, Rpl=radius, rhill=rhill, - Ip1=Ip1, Ip2=Ip2, Ip3=Ip3, - rotx=rotx, roty=roty, rotz=rotz, - J2=J2, J4=J4,t=t) + 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.ic = self.data.copy(deep=True) - return dsnew + return def _combine_and_fix_dsnew(self,dsnew): """ @@ -2549,6 +2479,7 @@ def get_nvals(ds): self.data = get_nvals(self.data) self.data = self.data.sortby("id") + self.data = io.reorder_dims(self.data) return dsnew @@ -2592,11 +2523,12 @@ def read_param(self, self.param = io.read_swiftest_param(param_file, self.param, verbose=verbose) if read_init_cond: if "NETCDF" in self.param['IN_TYPE']: - init_cond_file = self.sim_dir / self.param['NC_IN'] + 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.ic = self.data.copy(deep=True) else: warnings.warn(f"Initial conditions file file {init_cond_file} not found.", stacklevel=2) else: @@ -2721,12 +2653,14 @@ def convert(self, param_file, newcodename="Swiftest", plname="pl.swiftest.in", t 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 ------- @@ -2737,10 +2671,17 @@ def bin2xr(self): # 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.sim_dir, self.param['BIN_OUT']) + param_tmp['BIN_OUT'] = os.path.join(self.simdir, self.param['BIN_OUT']) if self.codename == "Swiftest": 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 "NETCDF" in self.param['IN_TYPE']: + param_tmp['BIN_OUT'] = os.path.join(self.simdir, self.param['NC_IN']) + self.ic = io.swiftest2xr(param_tmp, verbose=self.verbose) + else: + self.ic = self.data.isel(time=0) + elif self.codename == "Swifter": self.data = io.swifter2xr(param_tmp, verbose=self.verbose) if self.verbose: print('Swifter simulation data stored as xarray DataSet .data') @@ -2764,11 +2705,11 @@ def follow(self, codestyle="Swifter"): fol : xarray dataset """ if self.data is None: - self.bin2xr() + 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() # 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 @@ -2829,7 +2770,7 @@ def save(self, param = self.param if codename == "Swiftest": - infile_name = Path(self.sim_dir) / param['NC_IN'] + 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": diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 63c89f2b3..668b07c47 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -28,6 +28,7 @@ SET(FAST_MATH_FILES ${SRC}/discard/discard.f90 ${SRC}/drift/drift.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 diff --git a/src/discard/discard.f90 b/src/discard/discard.f90 index 55ad97f65..41ece554b 100644 --- a/src/discard/discard.f90 +++ b/src/discard/discard.f90 @@ -38,8 +38,8 @@ module subroutine discard_system(self, param) call tp%discard(system, param) ltp_discards = (tp_discards%nbody > 0) end if - if (ltp_discards) call tp_discards%write_particle_info(param%nciu, param) - if (lpl_discards) call pl_discards%write_particle_info(param%nciu, param) + if (ltp_discards) call tp_discards%write_info(param%nciu, param) + if (lpl_discards) call pl_discards%write_info(param%nciu, 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) @@ -131,7 +131,7 @@ subroutine discard_cb_tp(tp, system, param) 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) @@ -140,7 +140,7 @@ subroutine discard_cb_tp(tp, system, param) " 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=system%t, discard_xh=tp%xh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_RMAX", discard_time=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 @@ -150,7 +150,7 @@ subroutine discard_cb_tp(tp, system, param) " 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=system%t, discard_xh=tp%xh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_RMIN", discard_time=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)) @@ -164,7 +164,7 @@ subroutine discard_cb_tp(tp, system, param) " 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=system%t, discard_xh=tp%xh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_RMAXU", discard_time=system%t, discard_rh=tp%rh(:,i), & discard_vh=tp%vh(:,i)) end if end if @@ -201,7 +201,7 @@ subroutine discard_peri_tp(tp, system, param) 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 @@ -215,7 +215,7 @@ subroutine discard_peri_tp(tp, system, param) 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=system%t, discard_xh=tp%xh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_PERI", discard_time=system%t, discard_rh=tp%rh(:,i), & discard_vh=tp%vh(:,i), discard_body_id=pl%id(j)) end if end if @@ -250,7 +250,7 @@ subroutine discard_pl_tp(tp, system, param) 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) @@ -265,7 +265,7 @@ subroutine discard_pl_tp(tp, system, param) // " 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=system%t, discard_xh=tp%xh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_PLR", discard_time=system%t, discard_rh=tp%rh(:,i), & discard_vh=tp%vh(:,i), discard_body_id=pl%id(j)) exit end if diff --git a/src/drift/drift.f90 b/src/drift/drift.f90 index b2e3c1b9a..7c7c2bdba 100644 --- a/src/drift/drift.f90 +++ b/src/drift/drift.f90 @@ -39,7 +39,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 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 diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 new file mode 100644 index 000000000..d28ecd1f5 --- /dev/null +++ b/src/encounter/encounter_io.f90 @@ -0,0 +1,193 @@ +!! 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_io + use swiftest + use netcdf +contains + + module subroutine encounter_io_dump_storage_list(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(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i + + ! Most of this is just temporary test code just to get something working. Eventually this should get cleaned up. + call self%nciu%initialize(param) + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) then + select type(plplenc_list => self%frame(i)%item) + class is (symba_plplenc) + self%nciu%ienc_frame = i + call plplenc_list%write_frame(self%nciu,param) + end select + end if + end do + call self%nciu%close() + + + return + end subroutine encounter_io_dump_storage_list + + + module subroutine encounter_io_initialize_output(self, param) + !! author: David A. Minton + !! + !! Initialize a NetCDF encounter file system and defines all variables. + use, intrinsic :: ieee_arithmetic + implicit none + ! Arguments + class(encounter_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + ! Internals + real(DP) :: dfill + real(SP) :: sfill + logical :: fileExists + character(len=STRMAX) :: errmsg + integer(I4B), dimension(2), parameter :: collider_dimension = [1,2] + + 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=self%enc_file, exist=fileExists) + if (fileExists) then + open(unit=LUN, file=self%enc_file, status="old", err=667, iomsg=errmsg) + close(unit=LUN, status="delete") + end if + + call check( nf90_create(self%enc_file, NF90_NETCDF4, self%id), "encounter_io_initialize_output nf90_create" ) + + call check( nf90_def_dim(self%id, self%eid_dimname, NF90_UNLIMITED, self%eid_dimid), "encounter_io_initialize_output nf90_def_dim eid_dimid" ) + call check( nf90_def_dim(self%id, self%str_dimname, NAMELEN, self%str_dimid), "encounter_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call check( nf90_def_dim(self%id, self%time_dimname, NF90_UNLIMITED, self%time_dimid), "encounter_io_initialize_output nf90_def_dim time_dimid" ) ! 'y' dimension + call check( nf90_def_dim(self%id, self%collider_dimname, self%collider_dim_size, self%collider_dimid), "encounter_io_initialize_output nf90_def_dim time_dimid" ) ! 'y' dimension + + select case (param%out_type) + case("NETCDF_FLOAT") + self%out_type = NF90_FLOAT + case("NETCDF_DOUBLE") + self%out_type = NF90_DOUBLE + end select + + ! call check( nf90_def_var(self%id, self%time_dimname, self%out_type, self%time_dimid, self%time_varid), "encounter_io_initialize_output nf90_def_var time_varid" ) + ! call check( nf90_def_var(self%id, self%nenc_varname, NF90_INT, self%time_dimid, self%nenc_varid), "encounter_io_initialize_output nf90_def_var nenc_varid" ) + ! call check( nf90_def_var(self%id, self%name_varname, NF90_CHAR, [self%str_dimid, self%collider_dimid, self%eid_dimid], self%name_varid), "encounter_io_initialize_output nf90_def_var name_varid" ) + ! call check( nf90_def_var(self%id, self%id_dimname, NF90_INT, [self%collider_dimid, self%eid_dimid, self%time_dimid], self%id_varid), "encounter_io_initialize_output nf90_def_var id_varid" ) + ! call check( nf90_def_var(self%id, self%rh_varname, self%out_type, [self%collider_dimid, self%eid_dimid, self%time_dimid], self%rh_varid), "encounter_io_initialize_output nf90_def_var rh_varid" ) + ! call check( nf90_def_var(self%id, self%vh_varname, self%out_type, [self%collider_dimid, self%eid_dimid, self%time_dimid], self%vh_varid), "encounter_io_initialize_output nf90_def_var vh_varid" ) + ! call check( nf90_def_var(self%id, self%level_varname, NF90_INT, [self%eid_dimid, self%time_dimid], self%level_varid), "encounter_io_initialize_output nf90_def_var level_varid" ) + ! call check( nf90_def_var(self%id, self%gmass_varname, self%out_type, [self%collider_dimid, self%eid_dimid, self%time_dimid], self%Gmass_varid), "encounter_io_initialize_output nf90_def_var Gmass_varid" ) + ! call check( nf90_def_var(self%id, self%radius_varname, self%out_type, [self%collider_dimid, self%eid_dimid, self%time_dimid], self%radius_varid), "encounter_io_initialize_output nf90_def_var radius_varid" ) + + + ! Take the file out of define mode + call check( nf90_enddef(self%id), "encounter_io_initialize_output nf90_enddef" ) + + return + + 667 continue + write(*,*) "Error creating encounter output file. " // trim(adjustl(errmsg)) + call util_exit(FAILURE) + end subroutine encounter_io_initialize_output + + + module subroutine encounter_io_open_file(self, param, readonly) + !! author: David A. Minton + !! + !! Opens a NetCDF encounter file and does the variable inquiries to activate variable ids + implicit none + ! Arguments + class(encounter_io_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 + character(len=STRMAX) :: errmsg + + mode = NF90_WRITE + if (present(readonly)) then + if (readonly) mode = NF90_NOWRITE + end if + + write(errmsg,*) "encounter_io_open_file nf90_open ",trim(adjustl(param%outfile)) + call check( nf90_open(self%enc_file, mode, self%id), errmsg) + + ! call check( nf90_inq_dimid(self%id, self%time_dimname, self%time_dimid), "encounter_io_open_file nf90_inq_dimid time_dimid" ) + ! call check( nf90_inq_dimid(self%id, self%eid_dimname, self%eid_dimid), "encounter_io_open_file nf90_inq_dimid eid_dimid" ) + ! call check( nf90_inq_dimid(self%id, self%collider_dimname, self%collider_dimid), "encounter_io_open_file nf90_inq_dimid collider_dimid" ) + ! call check( nf90_inq_dimid(self%id, self%str_dimname, self%str_dimid), "encounter_io_open_file nf90_inq_dimid collider_str" ) + + ! call check( nf90_inq_varid(self%id, self%time_dimname, self%time_varid), "encounter_io_open_file nf90_inq_varid time_varid" ) + ! call check( nf90_inq_varid(self%id, self%name_varname, self%name_varid), "encounter_io_open_file nf90_inq_varid name_varid" ) + ! call check( nf90_inq_varid(self%id, self%nenc_varname, self%nenc_varid), "encounter_io_open_file nf90_inq_varid nenc_varid" ) + + ! call check( nf90_inq_varid(self%id, self%xhx_varname, self%xhx_varid), "encounter_io_open_file nf90_inq_varid xhx_varid" ) + ! call check( nf90_inq_varid(self%id, self%xhy_varname, self%xhy_varid), "encounter_io_open_file nf90_inq_varid xhy_varid" ) + ! call check( nf90_inq_varid(self%id, self%xhz_varname, self%xhz_varid), "encounter_io_open_file nf90_inq_varid xhz_varid" ) + ! call check( nf90_inq_varid(self%id, self%vhx_varname, self%vhx_varid), "encounter_io_open_file nf90_inq_varid vhx_varid" ) + ! call check( nf90_inq_varid(self%id, self%vhy_varname, self%vhy_varid), "encounter_io_open_file nf90_inq_varid vhy_varid" ) + ! call check( nf90_inq_varid(self%id, self%vhz_varname, self%vhz_varid), "encounter_io_open_file nf90_inq_varid vhz_varid" ) + ! call check( nf90_inq_varid(self%id, self%level_varname, self%level_varid), "encounter_io_open_file nf90_inq_varid level_varid" ) + ! call check( nf90_inq_varid(self%id, self%gmass_varname, self%Gmass_varid), "encounter_io_open_file nf90_inq_varid Gmass_varid" ) + ! call check( nf90_inq_varid(self%id, self%radius_varname, self%radius_varid), "encounter_io_open_file nf90_inq_varid radius_varid" ) + + return + end subroutine encounter_io_open_file + + module subroutine encounter_io_write_frame(self, iu, param) + !! author: David A. Minton + !! + !! Write a frame of output of an encounter list structure. + implicit none + ! Arguments + class(encounter_list), intent(in) :: self !! Swiftest encounter structure + class(encounter_io_parameters), intent(inout) :: iu !! Parameters used to identify a particular encounter io NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i,old_mode, n + + i = iu%ienc_frame + n = int(self%nenc, kind=I4B) + call check( nf90_set_fill(iu%id, nf90_nofill, old_mode), "encounter_io_write_frame_base nf90_set_fill" ) + call check( nf90_put_var(iu%id, iu%time_varid, self%t, start=[i]), "encounter_io_write_frame nf90_put_var time_varid" ) + + ! call check( nf90_put_var(iu%id, iu%nenc_varid, self%nenc, start=[i]), "encounter_io_frame nf90_put_var nenc_varid" ) + ! call check( nf90_put_var(iu%id, iu%name_varid, self%name1(1:n), start=[1, 1, i], count=[NAMELEN,1,1]), "netcdf_write_frame nf90_put_var name 1" ) + ! call check( nf90_put_var(iu%id, iu%name_varid, self%name2(1:n), start=[1, 2, i], count=[NAMELEN,1,1]), "netcdf_write_frame nf90_put_var name 2" ) + ! call check( nf90_put_var(iu%id, iu%xhx_varid, self%x1(1, 1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame nf90_put_var xhx_varid 1" ) + ! call check( nf90_put_var(iu%id, iu%xhy_varid, self%x1(2, 1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame nf90_put_var xhy_varid 1" ) + ! call check( nf90_put_var(iu%id, iu%xhz_varid, self%x1(3, 1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame nf90_put_var xhz_varid 1" ) + ! call check( nf90_put_var(iu%id, iu%xhx_varid, self%x2(1, 1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame nf90_put_var xhx_varid 2" ) + ! call check( nf90_put_var(iu%id, iu%xhy_varid, self%x2(2, 1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame nf90_put_var xhy_varid 2" ) + ! call check( nf90_put_var(iu%id, iu%xhz_varid, self%x2(3, 1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame nf90_put_var xhz_varid 2" ) + ! call check( nf90_put_var(iu%id, iu%vhx_varid, self%v1(1, 1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame nf90_put_var vhx_varid 1" ) + ! call check( nf90_put_var(iu%id, iu%vhy_varid, self%v1(2, 1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame nf90_put_var vhy_varid 1" ) + ! call check( nf90_put_var(iu%id, iu%vhz_varid, self%v1(3, 1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame nf90_put_var vhz_varid 1" ) + ! call check( nf90_put_var(iu%id, iu%vhx_varid, self%v2(1, 1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame nf90_put_var vhx_varid 2" ) + ! call check( nf90_put_var(iu%id, iu%vhy_varid, self%v2(2, 1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame nf90_put_var vhy_varid 2" ) + ! call check( nf90_put_var(iu%id, iu%vhz_varid, self%v2(3, 1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame nf90_put_var vhz_varid 2" ) + ! call check( nf90_put_var(iu%id, iu%Gmass_varid, self%Gmass1(1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame nf90_put_var Gmass 1" ) + ! call check( nf90_put_var(iu%id, iu%Gmass_varid, self%Gmass2(1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame nf90_put_var Gmass 2" ) + ! call check( nf90_put_var(iu%id, iu%radius_varid, self%radius1(1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame nf90_put_var radius 1" ) + ! call check( nf90_put_var(iu%id, iu%radius_varid, self%radius2(1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame nf90_put_var radius 2" ) + ! select type(self) + ! class is (symba_encounter) + ! call check( nf90_put_var(iu%id, iu%level_varid, self%level(1:n), start=[1, i], count=[n,1]), "netcdf_write_frame nf90_put_var level" ) + ! end select + + return + end subroutine encounter_io_write_frame + +end submodule s_encounter_io \ No newline at end of file diff --git a/src/encounter/encounter_setup.f90 b/src/encounter/encounter_setup.f90 index 95b2680a0..c741cf0a7 100644 --- a/src/encounter/encounter_setup.f90 +++ b/src/encounter/encounter_setup.f90 @@ -62,6 +62,8 @@ module subroutine encounter_setup_list(self, n) ! Arguments class(encounter_list), intent(inout) :: self !! Swiftest encounter structure integer(I8B), intent(in) :: n !! Number of encounters to allocate space for + ! Internals + integer(I8B) :: i if (n < 0) return @@ -75,10 +77,16 @@ module subroutine encounter_setup_list(self, n) 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) + if (allocated(self%Gmass1)) deallocate(self%Gmass1) + if (allocated(self%Gmass2)) deallocate(self%Gmass2) + if (allocated(self%radius1)) deallocate(self%radius1) + if (allocated(self%radius2)) deallocate(self%radius2) + if (allocated(self%name1)) deallocate(self%name1) + if (allocated(self%name2)) deallocate(self%name2) self%nenc = n if (n == 0_I8B) return + self%t = 0.0_DP allocate(self%lvdotr(n)) allocate(self%status(n)) @@ -90,7 +98,12 @@ module subroutine encounter_setup_list(self, n) allocate(self%x2(NDIM,n)) allocate(self%v1(NDIM,n)) allocate(self%v2(NDIM,n)) - allocate(self%t(n)) + allocate(self%Gmass1(n)) + allocate(self%Gmass2(n)) + allocate(self%radius1(n)) + allocate(self%radius2(n)) + allocate(self%name1(n)) + allocate(self%name2(n)) self%lvdotr(:) = .false. self%status(:) = INACTIVE @@ -102,7 +115,14 @@ module subroutine encounter_setup_list(self, n) self%x2(:,:) = 0.0_DP self%v1(:,:) = 0.0_DP self%v2(:,:) = 0.0_DP - self%t(:) = 0.0_DP + self%Gmass1(:) = 0.0_DP + self%Gmass2(:) = 0.0_DP + self%radius1(:) = 0.0_DP + self%radius2(:) = 0.0_DP + do i = 1_I8B, n + self%name1(i) = "UNNAMED" + self%name2(i) = "UNNAMED" + end do return end subroutine encounter_setup_list diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 09cf6107e..cf7dc3a71 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -36,7 +36,12 @@ module subroutine encounter_util_append_list(self, source, 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 util_append(self%Gmass1, source%Gmass1, nold, nsrc, lsource_mask) + call util_append(self%Gmass2, source%Gmass2, nold, nsrc, lsource_mask) + call util_append(self%radius1, source%radius1, nold, nsrc, lsource_mask) + call util_append(self%radius2, source%radius2, nold, nsrc, lsource_mask) + call util_append(self%name1, source%name1, nold, nsrc, lsource_mask) + call util_append(self%name2, source%name2, nold, nsrc, lsource_mask) self%nenc = nold + count(lsource_mask(1:nsrc)) return @@ -54,6 +59,7 @@ module subroutine encounter_util_copy_list(self, source) associate(n => source%nenc) self%nenc = n + self%t = source%t self%lvdotr(1:n) = source%lvdotr(1:n) self%status(1:n) = source%status(1:n) self%index1(1:n) = source%index1(1:n) @@ -64,13 +70,17 @@ module subroutine encounter_util_copy_list(self, source) self%x2(:,1:n) = source%x2(:,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%Gmass1(1:n) = source%Gmass1(1:n) + self%Gmass2(1:n) = source%Gmass2(1:n) + self%radius1(1:n) = source%radius1(1:n) + self%radius2(1:n) = source%radius2(1:n) + self%name1(1:n) = source%name1(1:n) + self%name2(1:n) = source%name2(1:n) end associate return end subroutine encounter_util_copy_list - module subroutine encounter_util_dealloc_aabb(self) !! author: David A. Minton !! @@ -105,7 +115,12 @@ module subroutine encounter_util_dealloc_list(self) 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) + if (allocated(self%Gmass1)) deallocate(self%Gmass1) + if (allocated(self%Gmass2)) deallocate(self%Gmass2) + if (allocated(self%radius1)) deallocate(self%radius1) + if (allocated(self%radius2)) deallocate(self%radius2) + if (allocated(self%name1)) deallocate(self%name1) + if (allocated(self%name2)) deallocate(self%name2) return end subroutine encounter_util_dealloc_list @@ -149,11 +164,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 @@ -185,8 +200,8 @@ 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 @@ -201,7 +216,12 @@ module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestru 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 util_spill(keeps%Gmass1, discards%Gmass1, lspill_list, ldestructive) + call util_spill(keeps%Gmass2, discards%Gmass2, lspill_list, ldestructive) + call util_spill(keeps%radius1, discards%radius1, lspill_list, ldestructive) + call util_spill(keeps%radius2, discards%radius2, lspill_list, ldestructive) + call util_spill(keeps%name1, discards%name1, lspill_list, ldestructive) + call util_spill(keeps%name2, discards%name2, lspill_list, ldestructive) nenc_old = keeps%nenc diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index b1a60a25b..87d2d7d11 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -108,9 +108,9 @@ module subroutine fraggle_io_log_pl(pl, param) do i = 1, pl%nbody write(LUN, *) i, pl%vb(:,i) end do - write(LUN, *) "xh" + write(LUN, *) "rh" do i = 1, pl%nbody - write(LUN, *) i, pl%xh(:,i) + write(LUN, *) i, pl%rh(:,i) end do write(LUN, *) "vh" do i = 1, pl%nbody diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index e03e30eb5..5c0803912 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -37,7 +37,7 @@ module subroutine fraggle_util_add_fragments_to_system(frag, colliders, system, 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%rh(:,npl_before+i) = frag%xb(:,i) - cb%xb(:) pl%vh(:,npl_before+i) = frag%vb(:,i) - cb%vb(:) end do if (param%lrotation) then diff --git a/src/gr/gr.f90 b/src/gr/gr.f90 index 8b32c7654..0d7fb7aaa 100644 --- a/src/gr/gr.f90 +++ b/src/gr/gr.f90 @@ -34,11 +34,11 @@ pure module subroutine gr_kick_getaccb_ns_body(self, system, param) associate(n => self%nbody, cb => 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) @@ -113,7 +113,7 @@ pure module subroutine gr_p4_pos_kick(param, x, v, dt) end subroutine gr_p4_pos_kick - pure module subroutine gr_pseudovel2vel(param, mu, xh, pv, vh) + pure module subroutine gr_pseudovel2vel(param, mu, rh, pv, vh) !! author: David A. Minton !! !! Converts the relativistic pseudovelocity back into a veliocentric velocity @@ -128,7 +128,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,7 +136,7 @@ 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 @@ -161,7 +161,7 @@ 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 gr_pseudovel2vel(param, self%mu(i), self%rh(:, i), self%vh(:, i), vh(:, i)) end do call move_alloc(vh, self%vh) end associate @@ -170,7 +170,7 @@ pure module subroutine gr_pv2vh_body(self, param) end subroutine gr_pv2vh_body - pure module subroutine gr_vel2pseudovel(param, mu, xh, vh, pv) + pure module subroutine gr_vel2pseudovel(param, mu, rh, vh, pv) !! author: David A. Minton !! !! Converts the heliocentric velocity into a pseudovelocity with relativistic corrections. @@ -186,7 +186,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 +199,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(:)) @@ -263,7 +263,7 @@ 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 gr_vel2pseudovel(param, self%mu(i), self%rh(:, i), self%vh(:, i), pv(:, i)) end do call move_alloc(pv, self%vh) end associate diff --git a/src/helio/helio_drift.f90 b/src/helio/helio_drift.f90 index 1076532c0..06e98e0fa 100644 --- a/src/helio/helio_drift.f90 +++ b/src/helio/helio_drift.f90 @@ -36,7 +36,7 @@ module subroutine helio_drift_body(self, system, param, dt) iflag(:) = 0 allocate(mu(n)) mu(:) = system%cb%Gmass - call drift_all(mu, self%xh, self%vb, self%nbody, param, dt, self%lmask, iflag) + call 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 @@ -84,29 +84,29 @@ module subroutine helio_drift_tp(self, system, param, dt) 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 @@ -115,7 +115,7 @@ subroutine helio_drift_linear_all(xh, pt, dt, n, lmask) integer(I4B) :: i 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 return @@ -146,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(:) @@ -186,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..13209ce1a 100644 --- a/src/helio/helio_gr.f90 +++ b/src/helio/helio_gr.f90 @@ -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 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 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 @@ -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 gr_p4_pos_kick(param, pl%rh(:, i), pl%vb(:, i), dt) end do end associate @@ -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 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..b5161b405 100644 --- a/src/helio/helio_kick.f90 +++ b/src/helio/helio_kick.f90 @@ -112,9 +112,9 @@ module subroutine helio_kick_vb_pl(self, system, param, t, dt, lbeg) pl%ah(:, 1:npl) = 0.0_DP call pl%accel(system, param, t, lbeg) if (lbeg) then - call pl%set_beg_end(xbeg = pl%xh) + call pl%set_beg_end(xbeg = pl%rh) else - call pl%set_beg_end(xend = pl%xh) + call pl%set_beg_end(xend = 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 diff --git a/src/io/io.f90 b/src/io/io.f90 index 7ee5b9cbd..81aca06d1 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -178,7 +178,7 @@ module subroutine io_conservation_report(self, param, lterminal) if (abs(system%Mtot_error) > 100 * epsilon(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_I8B + param%ioutput = param%ioutput + 1 call self%write_frame(param%nciu, param) call param%nciu%close() call util_exit(FAILURE) @@ -270,7 +270,7 @@ module subroutine io_dump_system(self, param) end subroutine io_dump_system - module subroutine io_dump_system_storage(self, param) + module subroutine 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 system @@ -279,22 +279,26 @@ module subroutine io_dump_system_storage(self, param) !! 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 + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest simulation history storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I8B) :: i, iloop_start - - iloop_start = param%iloop - param%istep_out * param%dump_cadence + 1_I8B - do i = 1_I8B, param%dump_cadence - if (allocated(self%frame(i)%system)) then - param%ioutput = int(iloop_start / param%istep_out, kind=I8B) + i - call self%frame(i)%system%write_frame(param) - deallocate(self%frame(i)%system) + integer(I4B) :: i + integer(I8B) :: iloop_start + + iloop_start = param%iloop - int(param%istep_out * param%dump_cadence + 1, kind=I8B) + do i = 1, param%dump_cadence + param%ioutput = int(iloop_start / param%istep_out, kind=I4B) + i + if (allocated(self%frame(i)%item)) then + select type(system => self%frame(i)%item) + class is (swiftest_nbody_system) + call system%write_frame(param) + end select + deallocate(self%frame(i)%item) end if end do return - end subroutine io_dump_system_storage + end subroutine io_dump_storage module subroutine io_get_args(integrator, param_file_name, display_style) @@ -493,8 +497,9 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) 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(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 + character(len=:), allocatable :: integrator ! Parse the file line by line, extracting tokens then matching them up with known parameters if possible @@ -758,30 +763,29 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) ! 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 + 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 - - ! 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 + 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 + 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") @@ -1377,7 +1381,7 @@ module function io_read_frame_body(self, iu, param) result(ierr) 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%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) @@ -1440,8 +1444,8 @@ module subroutine io_read_in_param(self, param_file_name) character(STRMAX) :: errmsg !! Error message in UDIO procedure ! Read in name of parameter file - write(self%display_unit, *) 'Parameter input file is ', trim(adjustl(param_file_name)) - self%param_file_name = param_file_name + 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. diff --git a/src/kick/kick.f90 b/src/kick/kick.f90 index dd0682bf0..40b238fec 100644 --- a/src/kick/kick.f90 +++ b/src/kick/kick.f90 @@ -43,15 +43,15 @@ module subroutine kick_getacch_int_pl(self, param) if (param%lflatten_interactions) then 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 kick_getacch_int_all_flat_pl(self%nbody, self%nplpl, self%k_plpl, 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 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_triangular_pl(self%nbody, self%nbody, self%xh, self%Gmass, self%radius, self%ah) + call kick_getacch_int_all_triangular_pl(self%nbody, self%nbody, self%rh, 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) + call kick_getacch_int_all_triangular_pl(self%nbody, self%nbody, self%rh, self%Gmass, acc=self%ah) end if end if @@ -80,7 +80,7 @@ module subroutine kick_getacch_int_tp(self, param, GMpl, xhp, npl) 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 kick_getacch_int_all_tp(self%nbody, npl, self%rh, xhp, GMpl, self%lmask, self%ah) return end subroutine kick_getacch_int_tp diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index a9af0cc71..846915444 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -18,16 +18,15 @@ program swiftest_driver 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 - character(len=:), allocatable :: integrator !! Integrator type code (see swiftest_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) :: idump !! Dump cadence counter - integer(I8B) :: iout !! Output cadence counter - integer(I8B) :: istart !! Starting index for loop counter - integer(I8B) :: nloops !! Number of steps to take in the simulation - integer(I8B) :: iframe !! System history frame cindex + 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 swiftest_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 type(progress_bar) :: pbar !! Object used to print out a progress bar @@ -39,7 +38,7 @@ program swiftest_driver character(len=64) :: pbarmessage character(*), parameter :: symbacompactfmt = '(";NPLM",ES22.15,$)' - type(swiftest_storage(nframes=:)), allocatable :: system_history + type(swiftest_storage(nframes=:)), allocatable :: system_history call io_get_args(integrator, param_file_name, display_style) @@ -50,7 +49,7 @@ program swiftest_driver case default allocate(swiftest_parameters :: param) end select - param%integrator = integrator + param%integrator = trim(adjustl(integrator)) call param%set_display(display_style) !> Define the maximum number of threads @@ -80,15 +79,13 @@ program swiftest_driver ! Set up loop and output cadence variables t = tstart - iout = istep_out nloops = ceiling((tstop - t0) / dt, kind=I8B) istart = ceiling((tstart - t0) / dt + 1, kind=I8B) - ioutput = int(istart / istep_out, kind=I8B) + ioutput = int(istart / istep_out, kind=I4B) ! Set up system storage for intermittent file dumps if (dump_cadence == 0) dump_cadence = ceiling(nloops / (1.0_DP * istep_out), kind=I8B) allocate(swiftest_storage(dump_cadence) :: system_history) - idump = dump_cadence ! 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%lrestart) then @@ -96,6 +93,7 @@ program swiftest_driver else if (param%lenergy) call nbody_system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum call nbody_system%write_frame(param) + call nbody_system%dump(param) end if write(display_unit, *) " *************** Main Loop *************** " @@ -105,10 +103,12 @@ program swiftest_driver write(pbarmessage,fmt=pbarfmt) t0, tstop call pbar%update(1,message=pbarmessage) else if (display_style == "COMPACT") then - write(*,*) "SWIFTEST START " // trim(adjustl(param%integrator)) + write(*,*) "SWIFTEST START " // param%integrator call nbody_system%compact_output(param,integration_timer) end if + iout = 0 + idump = 0 do iloop = istart, nloops !> Step the system forward in time call integration_timer%start() @@ -123,16 +123,16 @@ program swiftest_driver !> 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 - idump = idump - 1 - iframe = dump_cadence - idump - system_history%frame(iframe) = nbody_system - - if (idump == 0) then + iout = iout + 1 + if (iout == istep_out) then + iout = 0 + idump = idump + 1 + system_history%frame(idump) = nbody_system + + if (idump == dump_cadence) then + idump = 0 call nbody_system%dump(param) call system_history%dump(param) - idump = dump_cadence end if tfrac = (t - t0) / (tstop - t0) @@ -155,14 +155,13 @@ program swiftest_driver call integration_timer%reset() - iout = istep_out end if end if end do ! Dump any remaining history if it exists call system_history%dump(param) - if (display_style == "COMPACT") write(*,*) "SWIFTEST STOP" // trim(adjustl(param%integrator)) + if (display_style == "COMPACT") write(*,*) "SWIFTEST STOP" // param%integrator end associate call util_exit(SUCCESS) diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index b562def23..a7f2d72ac 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -19,28 +19,61 @@ module encounter_classes 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 + integer(I8B) :: nenc = 0 !! Total number of encounters + real(DP) :: t !! Time of encounter + 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 :: Gmass1 !! G*mass of body 1 in the encounter + real(DP), dimension(:), allocatable :: Gmass2 !! G*mass of body 2 in the encounter + real(DP), dimension(:), allocatable :: radius1 !! radius of body 1 in the encounter + real(DP), dimension(:), allocatable :: radius2 !! radius of body 2 in the encounter + character(NAMELEN), dimension(:), allocatable :: name1 !! name body 1 in the encounter + character(NAMELEN), dimension(:), allocatable :: name2 !! name of body 2 in the encounter 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. - final :: encounter_util_final_list !! Finalize the encounter list - deallocates all allocatables + 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_frame => encounter_io_write_frame !! Writes a frame of encounter data to file + final :: encounter_util_final_list !! Finalize the encounter list - deallocates all allocatables end type encounter_list + !! NetCDF dimension and variable names for the enounter save object + type, extends(netcdf_parameters) :: encounter_io_parameters + integer(I4B) :: COLLIDER_DIM_SIZE = 2 !! Size of collider dimension + integer(I4B) :: ienc_frame !! Current frame number for the encounter history + character(STRMAX) :: enc_file = "encounter.nc" !! Encounter output file name + + character(NAMELEN) :: eid_dimname = "encounter" !! The index of the encountering pair in the encounter list + integer(I4B) :: eid_dimid !! ID for the encounter pair index dimension + character(NAMELEN) :: collider_dimname = "collider" !! Dimension that defines the colliding bodies (bodies 1 and 2 are at dimension coordinates 1 and 2, respectively) + integer(I4B) :: collider_dimid !! ID for the collider dimension + character(NAMELEN) :: nenc_varname = "nenc" !! Total number of encounters + integer(I4B) :: nenc_varid !! ID for the number of encounters variable + character(NAMELEN) :: level_varname = "level" !! Recursion depth + integer(I4B) :: level_varid !! ID for the recursion level variable + contains + procedure :: initialize => encounter_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object + procedure :: open => encounter_io_open_file !! Opens a NetCDF file + end type encounter_io_parameters + + type, extends(swiftest_storage) :: encounter_storage + !! A class that that is used to store simulation history data between file output + type(encounter_io_parameters) :: nciu + contains + procedure :: dump => encounter_io_dump_storage_list !! Dumps contents of encounter history to file + end type encounter_storage + type encounter_bounding_box_1D integer(I4B) :: n !! Number of bodies with extents integer(I4B), dimension(:), allocatable :: ind !! Sorted minimum/maximum extent indices (value > n indicates an ending index) @@ -173,15 +206,30 @@ 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_dump_storage_list(self, param) + implicit none + class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine encounter_io_dump_storage_list + + module subroutine encounter_io_initialize_output(self, param) + implicit none + class(encounter_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(in) :: param + end subroutine encounter_io_initialize_output + + module subroutine encounter_io_open_file(self, param, readonly) + implicit none + class(encounter_io_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 encounter_io_open_file + + module subroutine encounter_io_write_frame(self, iu, 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 + class(encounter_list), intent(in) :: self !! Swiftest encounter structure + class(encounter_io_parameters), intent(inout) :: iu !! Parameters used to identify a particular encounter io NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine encounter_io_write_frame module subroutine encounter_setup_aabb(self, n, n_last) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 33d5aa79e..a09aca917 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -16,6 +16,126 @@ module swiftest_classes implicit none public + !> NetCDF variable names and constants + + !! 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 !! 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) :: discard_body_id_varid !! 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. + + ! 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) :: id_dimname = "id" !! name of the particle id dimension + integer(I4B) :: id_dimid !! ID for the particle id dimension + integer(I4B) :: id_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) :: ptype_varname = "particle_type" !! name of the particle type variable + integer(I4B) :: ptype_varid !! ID for the particle type variable + character(NAMELEN) :: name_varname = "name" !! name of the particle name variable + integer(I4B) :: name_varid !! ID for the namevariable + 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) :: 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) :: L_spin_varname = "L_spin" !! name of the spin angular momentum vector variable + integer(I4B) :: L_spin_varid !! ID for the system spin angular momentum vector variable + character(NAMELEN) :: L_escape_varname = "L_escape" !! name of the escaped angular momentum vector variable + integer(I4B) :: L_escape_varid !! ID for the escaped angular momentum vector variable + character(NAMELEN) :: 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) :: status_varname = "status" !! name of the current status of the body variable (includes discard type) + integer(I4B) :: status_varid !! ID for the status variable + 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 + end type netcdf_variables + + type, extends(netcdf_variables) :: netcdf_parameters contains procedure :: close => netcdf_close !! Closes an open NetCDF file @@ -32,8 +152,8 @@ module swiftest_classes !> User defined parameters that are read in from the parameters input file. !> Each paramter is initialized to a default values. type :: swiftest_parameters - character(STRMAX) :: 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 + 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 @@ -41,7 +161,7 @@ module swiftest_classes real(DP) :: tstop = -1.0_DP !! Integration stop time real(DP) :: dt = -1.0_DP !! Time step integer(I8B) :: iloop = 0_I8B !! Main loop counter - integer(I8B) :: ioutput = 0_I8B !! Output counter + integer(I4B) :: ioutput = 0 !! 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 @@ -49,7 +169,7 @@ module swiftest_classes character(STRMAX) :: in_type = "ASCII" !! 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 = NETCDF_OUTFILE !! Name of output binary file + 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 @@ -132,11 +252,11 @@ module swiftest_classes 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_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_xh !! The heliocentric distance vector at the time of the particle's discard + 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 @@ -151,9 +271,9 @@ module swiftest_classes !! An abstract superclass for a generic Swiftest object contains !! The minimal methods that all systems must have - procedure :: read_in => io_read_in_base !! Read in body initial conditions from a file - procedure :: write_frame => 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_write_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_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_info => netcdf_write_info_base !! Dump contents of particle information metadata to file end type swiftest_base !******************************************************************************************************************************** @@ -202,7 +322,7 @@ module swiftest_classes 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 :: rh !! Swiftestcentric position real(DP), dimension(:,:), allocatable :: vh !! Swiftestcentric velocity real(DP), dimension(:,:), allocatable :: xb !! Barycentric position real(DP), dimension(:,:), allocatable :: vb !! Barycentric velocity @@ -284,7 +404,7 @@ module swiftest_classes 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 :: xh2xb => util_coord_rh2xb_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. @@ -324,7 +444,7 @@ module swiftest_classes 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 :: xh2xb => util_coord_rh2xb_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 @@ -417,19 +537,19 @@ module swiftest_classes generic :: write_frame => write_frame_system, write_frame_netcdf !! Generic method call for reading a frame of output data end type swiftest_nbody_system - type storage_frame - class(swiftest_nbody_system), allocatable :: system + type swiftest_storage_frame + class(*), allocatable :: item contains - procedure :: store => util_copy_store_system !! Stores a snapshot of the nbody system so that later it can be retrieved for saving to file. + procedure :: store => util_copy_store !! Stores a snapshot of the nbody system so that later it can be retrieved for saving to file. generic :: assignment(=) => store end type - type, extends(swiftest_base) :: swiftest_storage(nframes) - integer(I8B), len :: nframes - !! A class that that is used to store simulation history data between file output - type(storage_frame), dimension(nframes) :: frame + type :: swiftest_storage(nframes) + integer(I4B), len :: nframes + !! An abstract class that establishes the pattern for various storage objects + type(swiftest_storage_frame), dimension(nframes) :: frame contains - procedure :: dump => io_dump_system_storage + procedure :: dump => io_dump_storage end type swiftest_storage abstract interface @@ -449,7 +569,6 @@ subroutine abstract_discard_body(self, system, param) 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 @@ -493,9 +612,17 @@ subroutine abstract_step_system(self, param, t, dt) real(DP), intent(in) :: t !! Simulation time real(DP), intent(in) :: dt !! Current stepsize end subroutine abstract_step_system + end interface interface + + module subroutine 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 + end subroutine check + module subroutine discard_pl(self, system, param) implicit none class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object @@ -569,11 +696,11 @@ pure module subroutine gr_p4_pos_kick(param, x, v, dt) real(DP), intent(in) :: dt !! Step size end subroutine gr_p4_pos_kick - pure module subroutine gr_pseudovel2vel(param, mu, xh, pv, vh) + pure module subroutine 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) :: xh !! Swiftestcentric position vector + 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 gr_pseudovel2vel @@ -584,11 +711,11 @@ pure module subroutine gr_pv2vh_body(self, param) 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) + pure module subroutine 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) :: xh !! Swiftestcentric position vector + 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 gr_vel2pseudovel @@ -625,12 +752,11 @@ module subroutine io_dump_system(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine io_dump_system - - module subroutine io_dump_system_storage(self, param) + module subroutine 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 io_dump_system_storage + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest simulation history storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine io_dump_storage module subroutine io_get_args(integrator, param_file_name, display_style) implicit none @@ -898,57 +1024,57 @@ module subroutine netcdf_sync(self) 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) + module function netcdf_read_frame_system(self, nciu, 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(netcdf_parameters), intent(inout) :: nciu !! 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) + module subroutine netcdf_read_hdr_system(self, nciu, 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(netcdf_parameters), intent(inout) :: nciu !! 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) + module subroutine netcdf_read_particle_info_system(self, nciu, 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(netcdf_parameters), intent(inout) :: nciu !! 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) + module subroutine netcdf_write_frame_base(self, nciu, 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(netcdf_parameters), intent(inout) :: nciu !! 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) + module subroutine netcdf_write_frame_system(self, nciu, 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(netcdf_parameters), intent(inout) :: nciu !! 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) + module subroutine netcdf_write_hdr_system(self, nciu, 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(netcdf_parameters), intent(inout) :: nciu !! 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) + module subroutine netcdf_write_info_base(self, nciu, 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(netcdf_parameters), intent(inout) :: nciu !! 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 + end subroutine netcdf_write_info_base module subroutine obl_acc_body(self, system) implicit none @@ -1009,7 +1135,7 @@ pure module subroutine orbel_xv2aqt(mu, px, py, pz, vx, vy, vz, a, q, capm, tper 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) + pure module subroutine 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 @@ -1020,6 +1146,11 @@ 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) end subroutine orbel_xv2el module subroutine orbel_xv2el_vec(self, cb) @@ -1218,17 +1349,17 @@ module subroutine util_coord_vh2vb_tp(self, vbcb) 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) + module subroutine util_coord_rh2xb_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 + end subroutine util_coord_rh2xb_pl - module subroutine util_coord_xh2xb_tp(self, cb) + module subroutine util_coord_rh2xb_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 + end subroutine util_coord_rh2xb_tp module subroutine util_copy_particle_info(self, source) implicit none @@ -1243,11 +1374,11 @@ module subroutine util_copy_particle_info_arr(source, dest, idx) 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_copy_store_system(self, system) + module subroutine util_copy_store(self, source) implicit none - class(storage_frame), intent(inout) :: self !! Swiftest storage frame object - class(swiftest_nbody_system), intent(in) :: system !! Swiftest n-body system object - end subroutine util_copy_store_system + class(swiftest_storage_frame), intent(inout) :: self !! Swiftest storage frame object + class(*), intent(in) :: source !! Any object that one wishes to store + end subroutine util_copy_store module subroutine util_dealloc_body(self) implicit none @@ -1500,7 +1631,7 @@ module subroutine util_set_mu_tp(self, cb) 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) + 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 @@ -1509,10 +1640,10 @@ module subroutine util_set_particle_info(self, name, particle_type, status, orig 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_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_xh !! The heliocentric distance vector at 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 util_set_particle_info @@ -1793,17 +1924,17 @@ 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 + 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 + 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 diff --git a/src/modules/swiftest_globals.f90 b/src/modules/swiftest_globals.f90 index f8e5674e4..4c8c21693 100644 --- a/src/modules/swiftest_globals.f90 +++ b/src/modules/swiftest_globals.f90 @@ -131,157 +131,4 @@ module swiftest_globals 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 = "string32" !! NetCDF name of the character string 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 index e016a36b9..cd97b74bd 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -16,20 +16,21 @@ module symba_classes 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 + use encounter_classes, only : encounter_list, encounter_storage 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 + 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. + 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. + character(STRMAX) :: encounter_save = "NONE" !! Indicate how encounter and/or fragmentation data should be saved contains procedure :: reader => symba_io_param_reader procedure :: writer => symba_io_param_writer @@ -45,7 +46,7 @@ module symba_classes 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 + final :: symba_util_final_kin !! Finalizes the SyMBA kinship object - deallocates all allocatables end type symba_kinship !******************************************************************************************************************************** @@ -53,8 +54,8 @@ module symba_classes !******************************************************************************************************************************* !> 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) :: 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 @@ -141,7 +142,8 @@ module symba_classes !******************************************************************************************************************************* !> SyMBA class for tracking close encounters in a step type, extends(encounter_list) :: symba_encounter - integer(I4B), dimension(:), allocatable :: level !! encounter recursion level + integer(I4B), dimension(:), allocatable :: level !! encounter recursion level + real(DP), dimension(:), allocatable :: tcollision !! Time of collision 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 @@ -179,11 +181,13 @@ module symba_classes ! 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 + 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 + type(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file + integer(I4B) :: ienc_frame = 0 !! Encounter history frame number 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 @@ -193,6 +197,7 @@ module symba_classes 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 + procedure :: resize_storage => symba_util_resize_storage final :: symba_util_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables end type symba_nbody_system @@ -219,7 +224,7 @@ module subroutine symba_collision_encounter_extract_collisions(self, system, par 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 + 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) @@ -696,6 +701,12 @@ module subroutine symba_util_resize_pl(self, nnew) integer(I4B), intent(in) :: nnew !! New size neded end subroutine symba_util_resize_pl + module subroutine symba_util_resize_storage(self, nnew) + implicit none + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object + integer(I4B), intent(in) :: nnew !! New size of list needed + end subroutine symba_util_resize_storage + module subroutine symba_util_resize_tp(self, nnew) implicit none class(symba_tp), intent(inout) :: self !! SyMBA massive body object diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index abd03f1d6..20cccc8e5 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -12,7 +12,7 @@ use netcdf contains - subroutine check(status, call_identifier) + module 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 @@ -39,7 +39,7 @@ module subroutine netcdf_close(self) ! Arguments class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - call check( nf90_close(self%ncid), "netcdf_close" ) + call check( nf90_close(self%id), "netcdf_close" ) return end subroutine netcdf_close @@ -76,56 +76,42 @@ module function netcdf_get_old_t_final_system(self, param) result(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), dimension(1) :: rtemp + real(DP), dimension(NDIM) :: vectemp, 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" ) + call check( nf90_inquire_dimension(param%nciu%id, param%nciu%time_dimid, len=itmax), "netcdf_get_old_t_final_system time_dimid" ) + call check( nf90_inquire_dimension(param%nciu%id, 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" ) + call check( nf90_get_var(param%nciu%id, param%nciu%time_varid, rtemp, start=[1], count=[1]), "netcdf_get_old_t_final_system time_varid" ) - !old_t_final = val(1) + !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 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%id, param%nciu%KE_orb_varid, rtemp, start=[1], count=[1]), "netcdf_get_old_t_final_system KE_orb_varid" ) + KE_orb_orig = rtemp(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%id, param%nciu%KE_spin_varid, rtemp, start=[1], count=[1]), "netcdf_get_old_t_final_system KE_spin_varid" ) + KE_spin_orig = rtemp(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%id, param%nciu%PE_varid, rtemp, start=[1], count=[1]), "netcdf_get_old_t_final_system PE_varid" ) + PE_orig = rtemp(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" ) + call check( nf90_get_var(param%nciu%id, param%nciu%Ecollisions_varid, self%Ecollisions, start=[1]), "netcdf_get_old_t_final_system Ecollisions_varid" ) + call check( nf90_get_var(param%nciu%id, 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" ) + call check( nf90_get_var(param%nciu%id, param%nciu%L_orb_varid, self%Lorbit_orig(:), start=[1,1], count=[NDIM,1]), "netcdf_get_old_t_final_system L_orb_varid" ) + call check( nf90_get_var(param%nciu%id, param%nciu%L_spin_varid, self%Lspin_orig(:), start=[1,1], count=[NDIM,1]), "netcdf_get_old_t_final_system L_spin_varid" ) + call check( nf90_get_var(param%nciu%id, param%nciu%L_escape_varid, self%Lescape(:), start=[1,1], count=[NDIM,1]), "netcdf_get_old_t_final_system L_escape_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" ) + call check( nf90_get_var(param%nciu%id, 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%id, 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) @@ -133,24 +119,13 @@ module function netcdf_get_old_t_final_system(self, param) result(old_t_final) 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) + call check( nf90_get_var(param%nciu%id, param%nciu%radius_varid, rtemp, start=[1,1], count=[1,1]), "netcdf_get_old_t_final_system radius_varid" ) + cb%R0 = rtemp(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) + call check( nf90_get_var(param%nciu%id, param%nciu%rot_varid, rot0, start=[1,1,1], count=[NDIM,1,1]), "netcdf_get_old_t_final_system rot_varid" ) + call check( nf90_get_var(param%nciu%id, param%nciu%Ip_varid, Ip0, start=[1,1,1], count=[NDIM,1,1]), "netcdf_get_old_t_final_system Ip_varid" ) cb%L0(:) = Ip0(3) * cb%GM0 * cb%R0**2 * rot0(:) @@ -175,7 +150,7 @@ module subroutine netcdf_initialize_output(self, param) 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 + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals integer(I4B) :: nvar, varid, vartype real(DP) :: dfill @@ -184,153 +159,143 @@ module subroutine netcdf_initialize_output(self, param) character(len=STRMAX) :: errmsg integer(I4B) :: ndims - dfill = ieee_value(dfill, IEEE_QUIET_NAN) - sfill = ieee_value(sfill, IEEE_QUIET_NAN) + associate(nciu => self) - ! 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 + dfill = ieee_value(dfill, IEEE_QUIET_NAN) + sfill = ieee_value(sfill, IEEE_QUIET_NAN) - call check( nf90_create(param%outfile, NF90_NETCDF4, self%ncid), "netcdf_initialize_output nf90_create" ) + select case (param%out_type) + case("NETCDF_FLOAT") + nciu%out_type = NF90_FLOAT + case("NETCDF_DOUBLE") + nciu%out_type = NF90_DOUBLE + end select - ! 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, STR_DIMNAME, NAMELEN, self%str_dimid), "netcdf_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - call check( nf90_def_dim(self%ncid, TIME_DIMNAME, NF90_UNLIMITED, self%time_dimid), "netcdf_initialize_output nf90_def_dim time_dimid" ) ! 'y' dimension + ! 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 - select case (param%out_type) - case("NETCDF_FLOAT") - self%out_type = NF90_FLOAT - case("NETCDF_DOUBLE") - self%out_type = NF90_DOUBLE - end select + ! Create the file + call check( nf90_create(param%outfile, NF90_NETCDF4, nciu%id), "netcdf_initialize_output nf90_create" ) + + ! Dimensions + call check( nf90_def_dim(nciu%id, nciu%time_dimname, NF90_UNLIMITED, nciu%time_dimid), "netcdf_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension + call check( nf90_def_dim(nciu%id, nciu%space_dimname, NDIM, nciu%space_dimid), "netcdf_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension + call check( nf90_def_dim(nciu%id, nciu%id_dimname, NF90_UNLIMITED, nciu%id_dimid), "netcdf_initialize_output nf90_def_dim id_dimid" ) ! dimension to store particle id numbers + call check( nf90_def_dim(nciu%id, nciu%str_dimname, NAMELEN, nciu%str_dimid), "netcdf_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + + ! Dimension coordinates + call check( nf90_def_var(nciu%id, nciu%time_dimname, nciu%out_type, nciu%time_dimid, nciu%time_varid), "netcdf_initialize_output nf90_def_var time_varid" ) + call check( nf90_def_var(nciu%id, nciu%space_dimname, NF90_CHAR, nciu%space_dimid, nciu%space_varid), "netcdf_initialize_output nf90_def_var space_varid" ) + call check( nf90_def_var(nciu%id, nciu%id_dimname, NF90_INT, nciu%id_dimid, nciu%id_varid), "netcdf_initialize_output nf90_def_var id_varid" ) + + ! Variables + call check( nf90_def_var(nciu%id, nciu%npl_varname, NF90_INT, nciu%time_dimid, nciu%npl_varid), "netcdf_initialize_output nf90_def_var npl_varid" ) + call check( nf90_def_var(nciu%id, nciu%ntp_varname, NF90_INT, nciu%time_dimid, nciu%ntp_varid), "netcdf_initialize_output nf90_def_var ntp_varid" ) + if (param%integrator == SYMBA) call check( nf90_def_var(nciu%id, nciu%nplm_varname, NF90_INT, nciu%time_dimid, nciu%nplm_varid), "netcdf_initialize_output nf90_def_var nplm_varid" ) + call check( nf90_def_var(nciu%id, nciu%name_varname, NF90_CHAR, [nciu%str_dimid, nciu%id_dimid], nciu%name_varid), "netcdf_initialize_output nf90_def_var name_varid" ) + call check( nf90_def_var(nciu%id, nciu%ptype_varname, NF90_CHAR, [nciu%str_dimid, nciu%id_dimid], nciu%ptype_varid), "netcdf_initialize_output nf90_def_var ptype_varid" ) + call check( nf90_def_var(nciu%id, nciu%status_varname, NF90_CHAR, [nciu%str_dimid, nciu%id_dimid], nciu%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(nciu%id, nciu%rh_varname, nciu%out_type, [nciu%space_dimid, nciu%id_dimid, nciu%time_dimid], nciu%rh_varid), "netcdf_initialize_output nf90_def_var rh_varid" ) + call check( nf90_def_var(nciu%id, nciu%vh_varname, nciu%out_type, [nciu%space_dimid, nciu%id_dimid, nciu%time_dimid], nciu%vh_varid), "netcdf_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 check( nf90_def_var(nciu%id, nciu%gr_pseudo_vh_varname, nciu%out_type, [nciu%space_dimid, nciu%id_dimid, nciu%time_dimid], nciu%gr_pseudo_vh_varid), "netcdf_initialize_output nf90_def_var gr_psuedo_vh_varid" ) + nciu%lpseudo_vel_exists = .true. + end if - !! 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 + + if ((param%out_form == "EL") .or. (param%out_form == "XVEL")) then + call check( nf90_def_var(nciu%id, nciu%a_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%a_varid), "netcdf_initialize_output nf90_def_var a_varid" ) + call check( nf90_def_var(nciu%id, nciu%e_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%e_varid), "netcdf_initialize_output nf90_def_var e_varid" ) + call check( nf90_def_var(nciu%id, nciu%inc_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%inc_varid), "netcdf_initialize_output nf90_def_var inc_varid" ) + call check( nf90_def_var(nciu%id, nciu%capom_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%capom_varid), "netcdf_initialize_output nf90_def_var capom_varid" ) + call check( nf90_def_var(nciu%id, nciu%omega_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%omega_varid), "netcdf_initialize_output nf90_def_var omega_varid" ) + call check( nf90_def_var(nciu%id, nciu%capm_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%capm_varid), "netcdf_initialize_output nf90_def_var capm_varid" ) + call check( nf90_def_var(nciu%id, nciu%varpi_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%varpi_varid), "netcdf_initialize_output nf90_def_var varpi_varid" ) + call check( nf90_def_var(nciu%id, nciu%lam_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%lam_varid), "netcdf_initialize_output nf90_def_var lam_varid" ) + call check( nf90_def_var(nciu%id, nciu%f_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%f_varid), "netcdf_initialize_output nf90_def_var f_varid" ) + call check( nf90_def_var(nciu%id, nciu%cape_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%cape_varid), "netcdf_initialize_output nf90_def_var cape_varid" ) 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(nciu%id, nciu%gmass_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%Gmass_varid), "netcdf_initialize_output nf90_def_var Gmass_varid" ) - 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(nciu%id, nciu%rhill_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%rhill_varid), "netcdf_initialize_output nf90_def_var rhill_varid" ) + end if - 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(nciu%id, nciu%radius_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%radius_varid), "netcdf_initialize_output nf90_def_var radius_varid" ) + + call check( nf90_def_var(nciu%id, nciu%origin_time_varname, nciu%out_type, nciu%id_dimid, nciu%origin_time_varid), "netcdf_initialize_output nf90_def_var origin_time_varid" ) + call check( nf90_def_var(nciu%id, nciu%origin_type_varname, NF90_CHAR, [nciu%str_dimid, nciu%id_dimid], & + nciu%origin_type_varid), "netcdf_initialize_output nf90_create" ) + call check( nf90_def_var(nciu%id, nciu%origin_rh_varname, nciu%out_type, [nciu%space_dimid, nciu%id_dimid], nciu%origin_rh_varid), "netcdf_initialize_output nf90_def_var origin_rh_varid" ) + call check( nf90_def_var(nciu%id, nciu%origin_vh_varname, nciu%out_type, [nciu%space_dimid, nciu%id_dimid], nciu%origin_vh_varid), "netcdf_initialize_output nf90_def_var origin_vh_varid" ) + + call check( nf90_def_var(nciu%id, nciu%collision_id_varname, NF90_INT, nciu%id_dimid, nciu%collision_id_varid), "netcdf_initialize_output nf90_def_var collision_id_varid" ) + call check( nf90_def_var(nciu%id, nciu%discard_time_varname, nciu%out_type, nciu%id_dimid, nciu%discard_time_varid), "netcdf_initialize_output nf90_def_var discard_time_varid" ) + call check( nf90_def_var(nciu%id, nciu%discard_rh_varname, nciu%out_type, [nciu%space_dimid, nciu%id_dimid], nciu%discard_rh_varid), "netcdf_initialize_output nf90_def_var discard_rh_varid" ) + call check( nf90_def_var(nciu%id, nciu%discard_vh_varname, nciu%out_type, [nciu%space_dimid, nciu%id_dimid], nciu%discard_vh_varid), "netcdf_initialize_output nf90_def_var discard_vh_varid" ) + call check( nf90_def_var(nciu%id, nciu%discard_body_id_varname, NF90_INT, nciu%id_dimid, nciu%discard_body_id_varid), "netcdf_initialize_output nf90_def_var discard_body_id_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(nciu%id, nciu%Ip_varname, nciu%out_type, [nciu%space_dimid, nciu%id_dimid, nciu%time_dimid], nciu%Ip_varid), "netcdf_initialize_output nf90_def_var Ip_varid" ) + call check( nf90_def_var(nciu%id, nciu%rot_varname, nciu%out_type, [nciu%space_dimid, nciu%id_dimid, nciu%time_dimid], nciu%rot_varid), "netcdf_initialize_output nf90_def_var rot_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(nciu%id, nciu%k2_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%k2_varid), "netcdf_initialize_output nf90_def_var k2_varid" ) + ! call check( nf90_def_var(nciu%id, nciu%q_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%Q_varid), "netcdf_initialize_output nf90_def_var Q_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(nciu%id, nciu%ke_orb_varname, nciu%out_type, nciu%time_dimid, nciu%KE_orb_varid), "netcdf_initialize_output nf90_def_var KE_orb_varid" ) + call check( nf90_def_var(nciu%id, nciu%ke_spin_varname, nciu%out_type, nciu%time_dimid, nciu%KE_spin_varid), "netcdf_initialize_output nf90_def_var KE_spin_varid" ) + call check( nf90_def_var(nciu%id, nciu%pe_varname, nciu%out_type, nciu%time_dimid, nciu%PE_varid), "netcdf_initialize_output nf90_def_var PE_varid" ) + call check( nf90_def_var(nciu%id, nciu%L_orb_varname, nciu%out_type, [nciu%space_dimid, nciu%time_dimid], nciu%L_orb_varid), "netcdf_initialize_output nf90_def_var L_orb_varid" ) + call check( nf90_def_var(nciu%id, nciu%L_spin_varname, nciu%out_type, [nciu%space_dimid, nciu%time_dimid], nciu%L_spin_varid), "netcdf_initialize_output nf90_def_var L_spin_varid" ) + call check( nf90_def_var(nciu%id, nciu%L_escape_varname, nciu%out_type, [nciu%space_dimid, nciu%time_dimid], nciu%L_escape_varid), "netcdf_initialize_output nf90_def_var L_escape_varid" ) + call check( nf90_def_var(nciu%id, nciu%Ecollisions_varname, nciu%out_type, nciu%time_dimid, nciu%Ecollisions_varid), "netcdf_initialize_output nf90_def_var Ecollisions_varid" ) + call check( nf90_def_var(nciu%id, nciu%Euntracked_varname, nciu%out_type, nciu%time_dimid, nciu%Euntracked_varid), "netcdf_initialize_output nf90_def_var Euntracked_varid" ) + call check( nf90_def_var(nciu%id, nciu%GMescape_varname, nciu%out_type, nciu%time_dimid, nciu%GMescape_varid), "netcdf_initialize_output nf90_def_var GMescape_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(nciu%id, nciu%j2rp2_varname, nciu%out_type, nciu%time_dimid, nciu%j2rp2_varid), "netcdf_initialize_output nf90_def_var j2rp2_varid" ) + call check( nf90_def_var(nciu%id, nciu%j4rp4_varname, nciu%out_type, nciu%time_dimid, nciu%j4rp4_varid), "netcdf_initialize_output nf90_def_var j4rp4_varid" ) + + + ! Set fill mode to NaN for all variables + call check( nf90_inquire(nciu%id, nVariables=nvar), "netcdf_initialize_output nf90_inquire nVariables" ) + do varid = 1, nvar + call check( nf90_inquire_variable(nciu%id, varid, xtype=vartype, ndims=ndims), "netcdf_initialize_output nf90_inquire_variable" ) + select case(vartype) + case(NF90_INT) + call check( nf90_def_var_fill(nciu%id, varid, 0, NF90_FILL_INT), "netcdf_initialize_output nf90_def_var_fill NF90_INT" ) + case(NF90_FLOAT) + call check( nf90_def_var_fill(nciu%id, varid, 0, sfill), "netcdf_initialize_output nf90_def_var_fill NF90_FLOAT" ) + case(NF90_DOUBLE) + call check( nf90_def_var_fill(nciu%id, varid, 0, dfill), "netcdf_initialize_output nf90_def_var_fill NF90_DOUBLE" ) + case(NF90_CHAR) + call check( nf90_def_var_fill(nciu%id, varid, 0, 0), "netcdf_initialize_output nf90_def_var_fill NF90_CHAR" ) + end select + end do - 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(nciu%id), "netcdf_initialize_output nf90_enddef" ) - ! Take the file out of define mode - call check( nf90_enddef(self%ncid), "netcdf_initialize_output nf90_enddef" ) + call check( nf90_put_var(nciu%id, nciu%space_varid, nciu%space_coords, start=[1], count=[NDIM]), "netcdf_initialize_output nf90_put_var space" ) + end associate return 667 continue @@ -350,7 +315,6 @@ module subroutine netcdf_open(self, param, readonly) 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 character(len=STRMAX) :: errmsg mode = NF90_WRITE @@ -358,190 +322,166 @@ module subroutine netcdf_open(self, param, readonly) if (readonly) mode = NF90_NOWRITE end if - write(errmsg,*) "netcdf_open nf90_open ",trim(adjustl(param%outfile)) - call check( nf90_open(param%outfile, mode, self%ncid), errmsg) + associate(nciu => self) - 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" ) - if (max(self%time_dimid,self%id_dimid) == 2) then - self%str_dimid = 3 - else if (min(self%time_dimid,self%id_dimid) == 0) then - self%str_dimid = 1 - else - self%str_dimid = 2 - end if - call check( nf90_inquire_dimension(self%ncid, self%str_dimid, 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" ) - - ! Required Variables - - 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, 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, GMASS_VARNAME, self%Gmass_varid), "netcdf_open nf90_inq_varid Gmass_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) + write(errmsg,*) "netcdf_open nf90_open ",trim(adjustl(param%outfile)) + call check( nf90_open(param%outfile, mode, nciu%id), errmsg) + + ! Dimensions + call check( nf90_inq_dimid(nciu%id, nciu%time_dimname, nciu%time_dimid), "netcdf_open nf90_inq_dimid time_dimid" ) + call check( nf90_inq_dimid(nciu%id, nciu%space_dimname, nciu%space_dimid), "netcdf_open nf90_inq_dimid space_dimid" ) + call check( nf90_inq_dimid(nciu%id, nciu%id_dimname, nciu%id_dimid), "netcdf_open nf90_inq_dimid id_dimid" ) + call check( nf90_inq_dimid(nciu%id, nciu%str_dimname, nciu%str_dimid), "netcdf_open nf90_inq_dimid str_dimid" ) + + ! Dimension coordinates + call check( nf90_inq_varid(nciu%id, nciu%time_dimname, nciu%time_varid), "netcdf_open nf90_inq_varid time_varid" ) + call check( nf90_inq_varid(nciu%id, nciu%space_dimname, nciu%space_varid), "netcdf_open nf90_inq_varid space_varid" ) + call check( nf90_inq_varid(nciu%id, nciu%id_dimname, nciu%id_varid), "netcdf_open nf90_inq_varid id_varid" ) + + ! Required Variables + call check( nf90_inq_varid(nciu%id, nciu%name_varname, nciu%name_varid), "netcdf_open nf90_inq_varid name_varid" ) + call check( nf90_inq_varid(nciu%id, nciu%gmass_varname, nciu%Gmass_varid), "netcdf_open nf90_inq_varid Gmass_varid" ) + + if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then + call check( nf90_inq_varid(nciu%id, nciu%rh_varname, nciu%rh_varid), "netcdf_open nf90_inq_varid rh_varid" ) + call check( nf90_inq_varid(nciu%id, nciu%vh_varname, nciu%vh_varid), "netcdf_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(nciu%id, nciu%gr_pseudo_vh_varname, nciu%gr_pseudo_vh_varid) + nciu%lpseudo_vel_exists = (status == nf90_noerr) + if (.not.nciu%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 - 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 + if ((param%out_form == "EL") .or. (param%out_form == "XVEL")) then + call check( nf90_inq_varid(nciu%id, nciu%a_varname, nciu%a_varid), "netcdf_open nf90_inq_varid a_varid" ) + call check( nf90_inq_varid(nciu%id, nciu%e_varname, nciu%e_varid), "netcdf_open nf90_inq_varid e_varid" ) + call check( nf90_inq_varid(nciu%id, nciu%inc_varname, nciu%inc_varid), "netcdf_open nf90_inq_varid inc_varid" ) + call check( nf90_inq_varid(nciu%id, nciu%capom_varname, nciu%capom_varid), "netcdf_open nf90_inq_varid capom_varid" ) + call check( nf90_inq_varid(nciu%id, nciu%omega_varname, nciu%omega_varid), "netcdf_open nf90_inq_varid omega_varid" ) + call check( nf90_inq_varid(nciu%id, nciu%capm_varname, nciu%capm_varid), "netcdf_open nf90_inq_varid capm_varid" ) 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 + if (param%lclose) then + call check( nf90_inq_varid(nciu%id, nciu%radius_varname, nciu%radius_varid), "netcdf_open nf90_inq_varid radius_varid" ) + end if - if (param%lclose) then - call check( nf90_inq_varid(self%ncid, RADIUS_VARNAME, self%radius_varid), "netcdf_open nf90_inq_varid radius_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%lrotation) then + call check( nf90_inq_varid(nciu%id, nciu%Ip_varname, nciu%Ip_varid), "netcdf_open nf90_inq_varid Ip_varid" ) + call check( nf90_inq_varid(nciu%id, nciu%rot_varname, nciu%rot_varid), "netcdf_open nf90_inq_varid rot_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%ltides) then + ! call check( nf90_inq_varid(nciu%id, nciu%k2_varname, nciu%k2_varid), "netcdf_open nf90_inq_varid k2_varid" ) + ! call check( nf90_inq_varid(nciu%id, nciu%q_varname, nciu%Q_varid), "netcdf_open nf90_inq_varid Q_varid" ) + ! end if - ! Optional Variables - if (param%lrhill_present) then - status = nf90_inq_varid(self%ncid, RHILL_VARNAME, self%rhill_varid) - if (status /= nf90_noerr) write(*,*) "Warning! RHILL variable not set in input file. Calculating." - end if + ! Optional Variables + if (param%lrhill_present) then + status = nf90_inq_varid(nciu%id, nciu%rhill_varname, nciu%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(self%ncid, NPL_VARNAME, self%npl_varid) - status = nf90_inq_varid(self%ncid, NTP_VARNAME, self%ntp_varid) - status = nf90_inq_varid(self%ncid, STATUS_VARNAME, self%status_varid) - status = nf90_inq_varid(self%ncid, J2RP2_VARNAME, self%j2rp2_varid) - status = nf90_inq_varid(self%ncid, J4RP4_VARNAME, self%j4rp4_varid) + ! Optional variables The User Doesn't Need to Know About + status = nf90_inq_varid(nciu%id, nciu%npl_varname, nciu%npl_varid) + status = nf90_inq_varid(nciu%id, nciu%ntp_varname, nciu%ntp_varid) + status = nf90_inq_varid(nciu%id, nciu%status_varname, nciu%status_varid) + status = nf90_inq_varid(nciu%id, nciu%j2rp2_varname, nciu%j2rp2_varid) + status = nf90_inq_varid(nciu%id, nciu%j4rp4_varname, nciu%j4rp4_varid) + status = nf90_inq_varid(nciu%id, nciu%ptype_varname, nciu%ptype_varid) + status = nf90_inq_varid(nciu%id, nciu%varpi_varname, nciu%varpi_varid) + status = nf90_inq_varid(nciu%id, nciu%lam_varname, nciu%lam_varid) + status = nf90_inq_varid(nciu%id, nciu%f_varname, nciu%f_varid) + status = nf90_inq_varid(nciu%id, nciu%cape_varname, nciu%cape_varid) + + if (param%integrator == SYMBA) then + status = nf90_inq_varid(nciu%id, nciu%nplm_varname, nciu%nplm_varid) + end if - if (param%integrator == SYMBA) then - status = nf90_inq_varid(self%ncid, NPLM_VARNAME, self%nplm_varid) - end if + if (param%lclose) then + status = nf90_inq_varid(nciu%id, nciu%origin_type_varname, nciu%origin_type_varid) + status = nf90_inq_varid(nciu%id, nciu%origin_time_varname, nciu%origin_time_varid) + status = nf90_inq_varid(nciu%id, nciu%origin_rh_varname, nciu%origin_rh_varid) + status = nf90_inq_varid(nciu%id, nciu%origin_vh_varname, nciu%origin_vh_varid) + status = nf90_inq_varid(nciu%id, nciu%collision_id_varname, nciu%collision_id_varid) + status = nf90_inq_varid(nciu%id, nciu%discard_time_varname, nciu%discard_time_varid) + status = nf90_inq_varid(nciu%id, nciu%discard_rh_varname, nciu%discard_rh_varid) + status = nf90_inq_varid(nciu%id, nciu%discard_vh_varname, nciu%discard_vh_varid) + status = nf90_inq_varid(nciu%id, nciu%discard_body_id_varname, nciu%discard_body_id_varid) + end if - if (param%lclose) then - status = nf90_inq_varid(self%ncid, ORIGIN_TYPE_VARNAME, self%origin_type_varid) - status = nf90_inq_varid(self%ncid, ORIGIN_TIME_VARNAME, self%origin_time_varid) - status = nf90_inq_varid(self%ncid, ORIGIN_XHX_VARNAME, self%origin_xhx_varid) - status = nf90_inq_varid(self%ncid, ORIGIN_XHY_VARNAME, self%origin_xhy_varid) - status = nf90_inq_varid(self%ncid, ORIGIN_XHZ_VARNAME, self%origin_xhz_varid) - status = nf90_inq_varid(self%ncid, ORIGIN_VHX_VARNAME, self%origin_vhx_varid) - status = nf90_inq_varid(self%ncid, ORIGIN_VHY_VARNAME, self%origin_vhy_varid) - status = nf90_inq_varid(self%ncid, ORIGIN_VHZ_VARNAME, self%origin_vhz_varid) - status = nf90_inq_varid(self%ncid, COLLISION_ID_VARNAME, self%collision_id_varid) - status = nf90_inq_varid(self%ncid, DISCARD_TIME_VARNAME, self%discard_time_varid) - status = nf90_inq_varid(self%ncid, DISCARD_XHX_VARNAME, self%discard_xhx_varid) - status = nf90_inq_varid(self%ncid, DISCARD_XHY_VARNAME, self%discard_xhy_varid) - status = nf90_inq_varid(self%ncid, DISCARD_XHZ_VARNAME, self%discard_xhz_varid) - status = nf90_inq_varid(self%ncid, DISCARD_VHX_VARNAME, self%discard_vhx_varid) - status = nf90_inq_varid(self%ncid, DISCARD_VHY_VARNAME, self%discard_vhy_varid) - status = nf90_inq_varid(self%ncid, DISCARD_VHZ_VARNAME, self%discard_vhz_varid) - status = nf90_inq_varid(self%ncid, DISCARD_BODY_ID_VARNAME, self%discard_body_id_varid) - end if + if (param%lenergy) then + status = nf90_inq_varid(nciu%id, nciu%ke_orb_varname, nciu%KE_orb_varid) + status = nf90_inq_varid(nciu%id, nciu%ke_spin_varname, nciu%KE_spin_varid) + status = nf90_inq_varid(nciu%id, nciu%pe_varname, nciu%PE_varid) + status = nf90_inq_varid(nciu%id, nciu%L_orb_varname, nciu%L_orb_varid) + status = nf90_inq_varid(nciu%id, nciu%L_spin_varname, nciu%L_spin_varid) + status = nf90_inq_varid(nciu%id, nciu%L_escape_varname, nciu%L_escape_varid) + status = nf90_inq_varid(nciu%id, nciu%Ecollisions_varname, nciu%Ecollisions_varid) + status = nf90_inq_varid(nciu%id, nciu%Euntracked_varname, nciu%Euntracked_varid) + status = nf90_inq_varid(nciu%id, nciu%GMescape_varname, nciu%GMescape_varid) + end if - if (param%lenergy) then - status = nf90_inq_varid(self%ncid, KE_ORB_VARNAME, self%KE_orb_varid) - status = nf90_inq_varid(self%ncid, KE_SPIN_VARNAME, self%KE_spin_varid) - status = nf90_inq_varid(self%ncid, PE_VARNAME, self%PE_varid) - status = nf90_inq_varid(self%ncid, L_ORBX_VARNAME, self%L_orbx_varid) - status = nf90_inq_varid(self%ncid, L_ORBY_VARNAME, self%L_orby_varid) - status = nf90_inq_varid(self%ncid, L_ORBZ_VARNAME, self%L_orbz_varid) - status = nf90_inq_varid(self%ncid, L_SPINX_VARNAME, self%L_spinx_varid) - status = nf90_inq_varid(self%ncid, L_SPINY_VARNAME, self%L_spiny_varid) - status = nf90_inq_varid(self%ncid, L_SPINZ_VARNAME, self%L_spinz_varid) - status = nf90_inq_varid(self%ncid, L_ESCAPEX_VARNAME, self%L_escapex_varid) - status = nf90_inq_varid(self%ncid, L_ESCAPEY_VARNAME, self%L_escapey_varid) - status = nf90_inq_varid(self%ncid, L_ESCAPEZ_VARNAME, self%L_escapez_varid) - status = nf90_inq_varid(self%ncid, ECOLLISIONS_VARNAME, self%Ecollisions_varid) - status = nf90_inq_varid(self%ncid, EUNTRACKED_VARNAME, self%Euntracked_varid) - status = nf90_inq_varid(self%ncid, GMESCAPE_VARNAME, self%GMescape_varid) - end if + end associate return end subroutine netcdf_open - module function netcdf_read_frame_system(self, iu, param) result(ierr) + module function netcdf_read_frame_system(self, nciu, 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(netcdf_parameters), intent(inout) :: nciu !! 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, status + 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 - call iu%open(param, readonly=.true.) - call self%read_hdr(iu, param) + call nciu%open(param, readonly=.true.) + call self%read_hdr(nciu, 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 + tslot = param%ioutput + 1 - call check( nf90_inquire_dimension(iu%ncid, iu%id_dimid, len=idmax), "netcdf_read_frame_system nf90_inquire_dimension id_dimid" ) + call check( nf90_inquire_dimension(nciu%id, nciu%id_dimid, len=idmax), "netcdf_read_frame_system nf90_inquire_dimension id_dimid" ) allocate(rtemp(idmax)) + allocate(vectemp(NDIM,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" ) + call check( nf90_inquire_dimension(nciu%id, nciu%time_dimid, len=t_max), "netcdf_read_frame_system nf90_inquire_dimension time_dimid" ) + call check( nf90_inquire_dimension(nciu%id, nciu%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" ) + call check( nf90_get_var(nciu%id, nciu%rh_varid, vectemp(:,:), start=[1, 1, tslot]), "netcdf_read_frame_system filter pass nf90_getvar rh_varid" ) + validmask(:) = vectemp(1,:) == vectemp(1,:) 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" ) + call check( nf90_get_var(nciu%id, nciu%a_varid, rtemp(:), start=[1, tslot]), "netcdf_read_frame_system filter pass nf90_getvar a_varid" ) + validmask(:) = rtemp(:) == rtemp(:) 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(:) + call check( nf90_get_var(nciu%id, nciu%Gmass_varid, rtemp(:), start=[1, tslot]), "netcdf_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 @@ -573,80 +513,62 @@ module function netcdf_read_frame_system(self, iu, param) result(ierr) ! 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(nciu%id, nciu%rh_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "netcdf_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 - 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) + if (param%lgr .and. nciu%lpseudo_vel_exists) then + call check( nf90_get_var(nciu%id, nciu%gr_pseudo_vh_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "netcdf_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 check( nf90_get_var(nciu%id, nciu%vh_varid, rtemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "netcdf_read_frame_system nf90_getvar vhx_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 check( nf90_get_var(iu%ncid, iu%a_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar a_varid" ) + call check( nf90_get_var(nciu%id, nciu%a_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_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 check( nf90_get_var(iu%ncid, iu%e_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar e_varid" ) + call check( nf90_get_var(nciu%id, nciu%e_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_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 check( nf90_get_var(iu%ncid, iu%inc_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar inc_varid" ) + call check( nf90_get_var(nciu%id, nciu%inc_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_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 check( nf90_get_var(iu%ncid, iu%capom_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar capom_varid" ) + call check( nf90_get_var(nciu%id, nciu%capom_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_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 check( nf90_get_var(iu%ncid, iu%omega_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar omega_varid" ) + call check( nf90_get_var(nciu%id, nciu%omega_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_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 check( nf90_get_var(iu%ncid, iu%capm_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar capm_varid" ) + call check( nf90_get_var(nciu%id, nciu%capm_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_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)) @@ -655,7 +577,7 @@ module function netcdf_read_frame_system(self, iu, param) result(ierr) end if - call check( nf90_get_var(iu%ncid, iu%Gmass_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar Gmass_varid" ) + call check( nf90_get_var(nciu%id, nciu%Gmass_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_read_frame_system nf90_getvar Gmass_varid" ) cb%Gmass = rtemp(1) cb%mass = cb%Gmass / param%GU @@ -671,13 +593,13 @@ module function netcdf_read_frame_system(self, iu, param) result(ierr) 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" ) + call check( nf90_get_var(nciu%id, nciu%rhill_varid, rtemp, start=[1, tslot], count=[idmax,1]), "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" ) + call check( nf90_get_var(nciu%id, nciu%radius_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_read_frame_system nf90_getvar radius_varid" ) cb%radius = rtemp(1) ! Set initial central body radius for SyMBA bookkeeping @@ -692,29 +614,17 @@ module function netcdf_read_frame_system(self, iu, param) result(ierr) 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(nciu%id, nciu%Ip_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "netcdf_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 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) + call check( nf90_get_var(nciu%id, nciu%rot_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "netcdf_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 Helio bookkeeping select type(cb) @@ -724,37 +634,37 @@ module function netcdf_read_frame_system(self, iu, param) result(ierr) 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" ) + ! call check( nf90_get_var(nciu%id, nciu%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" ) + ! call check( nf90_get_var(nciu%id, nciu%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 - status = nf90_inq_varid(iu%ncid, J2RP2_VARNAME, iu%j2rp2_varid) + status = nf90_inq_varid(nciu%id, nciu%j2rp2_varname, nciu%j2rp2_varid) if (status == nf90_noerr) then - 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(nciu%id, nciu%j2rp2_varid, cb%j2rp2, start=[tslot]), "netcdf_read_frame_system nf90_getvar j2rp2_varid" ) else cb%j2rp2 = 0.0_DP end if - status = nf90_inq_varid(iu%ncid, J4RP4_VARNAME, iu%j4rp4_varid) + status = nf90_inq_varid(nciu%id, nciu%j4rp4_varname, nciu%j4rp4_varid) if (status == nf90_noerr) then - call check( nf90_get_var(iu%ncid, iu%j4rp4_varid, cb%j4rp4, start=[tslot]), "netcdf_read_frame_system nf90_getvar j4rp4_varid" ) + call check( nf90_get_var(nciu%id, nciu%j4rp4_varid, cb%j4rp4, start=[tslot]), "netcdf_read_frame_system nf90_getvar j4rp4_varid" ) else cb%j4rp4 = 0.0_DP end if - call self%read_particle_info(iu, param, plmask, tpmask) + call self%read_particle_info(nciu, 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.(iu%lpseudo_vel_exists)) then + if (param%lgr .and. .not.(nciu%lpseudo_vel_exists)) then call pl%set_mu(cb) call tp%set_mu(cb) call pl%v2pv(param) @@ -763,7 +673,7 @@ module function netcdf_read_frame_system(self, iu, param) result(ierr) end associate - call iu%close() + call nciu%close() ierr = 0 return @@ -774,7 +684,7 @@ module function netcdf_read_frame_system(self, iu, param) result(ierr) end function netcdf_read_frame_system - module subroutine netcdf_read_hdr_system(self, iu, param) + module subroutine netcdf_read_hdr_system(self, nciu, param) !! author: David A. Minton !! !! Reads header information (variables that change with time, but not particle id). @@ -783,7 +693,7 @@ module subroutine netcdf_read_hdr_system(self, iu, param) 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(netcdf_parameters), intent(inout) :: nciu !! Parameters used to for writing a NetCDF dataset to file class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: tslot, status, idmax @@ -791,16 +701,16 @@ module subroutine netcdf_read_hdr_system(self, iu, param) logical, dimension(:), allocatable :: plmask, tpmask, plmmask - 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" ) - call check( nf90_get_var(iu%ncid, iu%time_varid, self%t, start=[tslot]), "netcdf_read_hdr_system nf90_getvar time_varid" ) + tslot = param%ioutput + 1 + call check( nf90_inquire_dimension(nciu%id, nciu%id_dimid, len=idmax), "netcdf_read_hdr_system nf90_inquire_dimension id_dimid" ) + call check( nf90_get_var(nciu%id, nciu%time_varid, self%t, start=[tslot]), "netcdf_read_hdr_system nf90_getvar time_varid" ) allocate(gmtemp(idmax)) allocate(tpmask(idmax)) allocate(plmask(idmax)) allocate(plmmask(idmax)) - call check( nf90_get_var(iu%ncid, iu%Gmass_varid, gmtemp, start=[1,1]), "netcdf_read_frame_system nf90_getvar Gmass_varid" ) + call check( nf90_get_var(nciu%id, nciu%Gmass_varid, gmtemp, start=[1,1], count=[idmax,1]), "netcdf_read_hdr_system nf90_getvar Gmass_varid" ) plmask(:) = gmtemp(:) == gmtemp(:) tpmask(:) = .not. plmask(:) @@ -813,26 +723,26 @@ module subroutine netcdf_read_hdr_system(self, iu, param) endwhere end select - status = nf90_inq_varid(iu%ncid, NPL_VARNAME, iu%npl_varid) + status = nf90_inq_varid(nciu%id, nciu%npl_varname, nciu%npl_varid) if (status == nf90_noerr) then - 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(nciu%id, nciu%npl_varid, self%pl%nbody, start=[tslot]), "netcdf_read_hdr_system nf90_getvar npl_varid" ) else self%pl%nbody = count(plmask(:)) end if - status = nf90_inq_varid(iu%ncid, NTP_VARNAME, iu%ntp_varid) + status = nf90_inq_varid(nciu%id, nciu%ntp_varname, nciu%ntp_varid) if (status == nf90_noerr) then - call check( nf90_get_var(iu%ncid, iu%ntp_varid, self%tp%nbody, start=[tslot]), "netcdf_read_hdr_system nf90_getvar ntp_varid" ) + call check( nf90_get_var(nciu%id, nciu%ntp_varid, self%tp%nbody, start=[tslot]), "netcdf_read_hdr_system nf90_getvar ntp_varid" ) else self%tp%nbody = count(tpmask(:)) end if if (param%integrator == SYMBA) then - status = nf90_inq_varid(iu%ncid, NPLM_VARNAME, iu%nplm_varid) + status = nf90_inq_varid(nciu%id, nciu%nplm_varname, nciu%nplm_varid) select type(pl => self%pl) class is (symba_pl) if (status == nf90_noerr) then - call check( nf90_get_var(iu%ncid, iu%nplm_varid, pl%nplm, start=[tslot]), "netcdf_read_hdr_system nf90_getvar nplm_varid" ) + call check( nf90_get_var(nciu%id, nciu%nplm_varid, pl%nplm, start=[tslot]), "netcdf_read_hdr_system nf90_getvar nplm_varid" ) else pl%nplm = count(plmmask(:)) end if @@ -840,57 +750,45 @@ module subroutine netcdf_read_hdr_system(self, iu, param) end if if (param%lenergy) then - status = nf90_inq_varid(iu%ncid, KE_ORB_VARNAME, iu%KE_orb_varid) - if (status == nf90_noerr) 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" ) - status = nf90_inq_varid(iu%ncid, KE_SPIN_VARNAME, iu%KE_spin_varid) - if (status == nf90_noerr) 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" ) - status = nf90_inq_varid(iu%ncid, PE_VARNAME, iu%PE_varid) - if (status == nf90_noerr) call check( nf90_get_var(iu%ncid, iu%PE_varid, self%pe, start=[tslot]), "netcdf_read_hdr_system nf90_getvar PE_varid" ) - status = nf90_inq_varid(iu%ncid, L_ORBX_VARNAME, iu%L_orbx_varid) - if (status == nf90_noerr) 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" ) - status = nf90_inq_varid(iu%ncid, L_ORBY_VARNAME, iu%L_orby_varid) - if (status == nf90_noerr) 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" ) - status = nf90_inq_varid(iu%ncid, L_ORBZ_VARNAME, iu%L_orbz_varid) - if (status == nf90_noerr) 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" ) - status = nf90_inq_varid(iu%ncid, L_SPINX_VARNAME, iu%L_spinx_varid) - if (status == nf90_noerr) 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" ) - status = nf90_inq_varid(iu%ncid, L_SPINY_VARNAME, iu%L_spiny_varid) - if (status == nf90_noerr) 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" ) - status = nf90_inq_varid(iu%ncid, L_SPINZ_VARNAME, iu%L_spinz_varid) - if (status == nf90_noerr) 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" ) - status = nf90_inq_varid(iu%ncid, L_ESCAPEX_VARNAME, iu%L_escapex_varid) - if (status == nf90_noerr) 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" ) - status = nf90_inq_varid(iu%ncid, L_ESCAPEY_VARNAME, iu%L_escapey_varid) - if (status == nf90_noerr) 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" ) - status = nf90_inq_varid(iu%ncid, L_ESCAPEZ_VARNAME, iu%L_escapez_varid) - if (status == nf90_noerr) 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" ) - status = nf90_inq_varid(iu%ncid, ECOLLISIONS_VARNAME, iu%Ecollisions_varid) - if (status == nf90_noerr) call check( nf90_get_var(iu%ncid, iu%Ecollisions_varid, self%Ecollisions, start=[tslot]), "netcdf_read_hdr_system nf90_getvar Ecollisions_varid" ) - status = nf90_inq_varid(iu%ncid, EUNTRACKED_VARNAME, iu%Euntracked_varid) - if (status == nf90_noerr) call check( nf90_get_var(iu%ncid, iu%Euntracked_varid, self%Euntracked, start=[tslot]), "netcdf_read_hdr_system nf90_getvar Euntracked_varid" ) - status = nf90_inq_varid(iu%ncid, GMESCAPE_VARNAME, iu%GMescape_varid) - if (status == nf90_noerr) call check( nf90_get_var(iu%ncid, iu%GMescape_varid, self%GMescape, start=[tslot]), "netcdf_read_hdr_system nf90_getvar GMescape_varid" ) + status = nf90_inq_varid(nciu%id, nciu%ke_orb_varname, nciu%KE_orb_varid) + if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%KE_orb_varid, self%ke_orbit, start=[tslot]), "netcdf_read_hdr_system nf90_getvar KE_orb_varid" ) + status = nf90_inq_varid(nciu%id, nciu%ke_spin_varname, nciu%KE_spin_varid) + if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%KE_spin_varid, self%ke_spin, start=[tslot]), "netcdf_read_hdr_system nf90_getvar KE_spin_varid" ) + status = nf90_inq_varid(nciu%id, nciu%pe_varname, nciu%PE_varid) + if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%PE_varid, self%pe, start=[tslot]), "netcdf_read_hdr_system nf90_getvar PE_varid" ) + status = nf90_inq_varid(nciu%id, nciu%L_orb_varname, nciu%L_orb_varid) + if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%L_orb_varid, self%Lorbit(:), start=[1,tslot], count=[NDIM,1]), "netcdf_read_hdr_system nf90_getvar L_orb_varid" ) + status = nf90_inq_varid(nciu%id, nciu%L_spin_varname, nciu%L_spin_varid) + if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%L_spin_varid, self%Lspin(:), start=[1,tslot], count=[NDIM,1]), "netcdf_read_hdr_system nf90_getvar L_spin_varid" ) + status = nf90_inq_varid(nciu%id, nciu%L_escape_varname, nciu%L_escape_varid) + if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%L_escape_varid, self%Lescape(:), start=[1, tslot], count=[NDIM,1]), "netcdf_read_hdr_system nf90_getvar L_escape_varid" ) + status = nf90_inq_varid(nciu%id, nciu%Ecollisions_varname, nciu%Ecollisions_varid) + if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%Ecollisions_varid, self%Ecollisions, start=[tslot]), "netcdf_read_hdr_system nf90_getvar Ecollisions_varid" ) + status = nf90_inq_varid(nciu%id, nciu%Euntracked_varname, nciu%Euntracked_varid) + if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%Euntracked_varid, self%Euntracked, start=[tslot]), "netcdf_read_hdr_system nf90_getvar Euntracked_varid" ) + status = nf90_inq_varid(nciu%id, nciu%GMescape_varname, nciu%GMescape_varid) + if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%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) + module subroutine netcdf_read_particle_info_system(self, nciu, 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(netcdf_parameters), intent(inout) :: nciu !! 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 :: rtemp_arr + real(DP), dimension(:,:), allocatable :: vectemp integer(I4B), dimension(:), allocatable :: itemp character(len=NAMELEN), dimension(:), allocatable :: ctemp integer(I4B), dimension(:), allocatable :: plind, tpind @@ -898,7 +796,7 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma ! 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(vectemp(NDIM,idmax)) allocate(itemp(idmax)) allocate(ctemp(idmax)) @@ -923,12 +821,12 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma 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" ) + call check( nf90_get_var(nciu%id, nciu%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 check( nf90_get_var(nciu%id, nciu%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))) @@ -937,18 +835,44 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma 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 + status = nf90_get_var(nciu%id, nciu%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 + select type(pl) + class is (symba_pl) + select type (param) + class is (symba_parameters) + do i = 1, npl + if (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 + end select + class default ! Non-SyMBA massive bodies + do i = 1, npl + call pl%info(i)%set_value(particle_type=PL_TYPE_NAME) + end do + end select + 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 - status = nf90_inq_varid(iu%ncid, STATUS_VARNAME, iu%status_varid) + status = nf90_inq_varid(nciu%id, nciu%status_varname, nciu%status_varid) if (status == nf90_noerr) then - call check( nf90_get_var(iu%ncid, iu%status_varid, ctemp, count=[NAMELEN, idmax]), "netcdf_read_particle_info_system nf90_getvar status_varid") + call check( nf90_get_var(nciu%id, nciu%status_varid, ctemp, count=[NAMELEN, idmax]), "netcdf_read_particle_info_system nf90_getvar status_varid") call cb%info%set_value(status=ctemp(1)) else call cb%info%set_value(status="ACTIVE") @@ -962,9 +886,9 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma if (param%lclose) then - status = nf90_inq_varid(iu%ncid, ORIGIN_TYPE_VARNAME, iu%origin_type_varid) + status = nf90_inq_varid(nciu%id, nciu%origin_type_varname, nciu%origin_type_varid) if (status == nf90_noerr) 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 check( nf90_get_var(nciu%id, nciu%origin_type_varid, ctemp, count=[NAMELEN, idmax]), "netcdf_read_particle_info_system nf90_getvar origin_type_varid" ) else ctemp = "Initial Conditions" end if @@ -977,9 +901,9 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma call tp%info(i)%set_value(origin_type=ctemp(tpind(i))) end do - status = nf90_inq_varid(iu%ncid, ORIGIN_TIME_VARNAME, iu%origin_time_varid) + status = nf90_inq_varid(nciu%id, nciu%origin_time_varname, nciu%origin_time_varid) if (status == nf90_noerr) then - call check( nf90_get_var(iu%ncid, iu%origin_time_varid, rtemp), "netcdf_read_particle_info_system nf90_getvar origin_time_varid" ) + call check( nf90_get_var(nciu%id, nciu%origin_time_varid, rtemp), "netcdf_read_particle_info_system nf90_getvar origin_time_varid" ) else rtemp = param%t0 end if @@ -992,77 +916,41 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma call tp%info(i)%set_value(origin_time=rtemp(tpind(i))) end do - status = nf90_inq_varid(iu%ncid, ORIGIN_XHX_VARNAME, iu%origin_xhx_varid) + status = nf90_inq_varid(nciu%id, nciu%origin_rh_varname, nciu%origin_rh_varid) if (status == nf90_noerr) then - 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(nciu%id, nciu%origin_rh_varid, vectemp(:,:)), "netcdf_read_particle_info_system nf90_getvar origin_rh_varid" ) else if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then - call check( nf90_get_var(iu%ncid, iu%xhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar xhx_varid" ) + call check( nf90_get_var(nciu%id, nciu%rh_varid, vectemp(:,:)), "netcdf_read_particle_info_system nf90_getvar rh_varid" ) else - rtemp_arr(1,:) = 0._DP - end if - - status = nf90_inq_varid(iu%ncid, ORIGIN_XHY_VARNAME, iu%origin_xhy_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(iu%ncid, iu%origin_xhy_varid, rtemp_arr(2,:)), "netcdf_read_particle_info_system nf90_getvar origin_xhy_varid" ) - else if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then - call check( nf90_get_var(iu%ncid, iu%xhy_varid, rtemp_arr(2,:)), "netcdf_read_particle_info_system nf90_getvar xhx_varid" ) - else - rtemp_arr(2,:) = 0._DP - end if - - status = nf90_inq_varid(iu%ncid, ORIGIN_XHZ_VARNAME, iu%origin_xhz_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(iu%ncid, iu%origin_xhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar origin_xhz_varid" ) - else if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then - call check( nf90_get_var(iu%ncid, iu%xhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar xhz_varid" ) - else - rtemp_arr(3,:) = 0._DP + vectemp(:,:) = 0._DP end if do i = 1, npl - call pl%info(i)%set_value(origin_xh=rtemp_arr(:,plind(i))) + call pl%info(i)%set_value(origin_rh=vectemp(:,plind(i))) end do do i = 1, ntp - call tp%info(i)%set_value(origin_xh=rtemp_arr(:,tpind(i))) + call tp%info(i)%set_value(origin_rh=vectemp(:,tpind(i))) end do - status = nf90_inq_varid(iu%ncid, ORIGIN_VHX_VARNAME, iu%origin_vhx_varid) + status = nf90_inq_varid(nciu%id, nciu%origin_vh_varname, nciu%origin_vh_varid) if (status == nf90_noerr) then - 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(nciu%id, nciu%origin_vh_varid, vectemp(:,:)), "netcdf_read_particle_info_system nf90_getvar origin_vh_varid" ) else if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then - call check( nf90_get_var(iu%ncid, iu%vhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar vhx_varid" ) + call check( nf90_get_var(nciu%id, nciu%vh_varid, vectemp(:,:)), "netcdf_read_particle_info_system nf90_getvar vh_varid" ) else - rtemp_arr(1,:) = 0._DP + vectemp(:,:) = 0._DP end if - status = nf90_inq_varid(iu%ncid, ORIGIN_VHY_VARNAME, iu%origin_vhy_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(iu%ncid, iu%origin_vhy_varid, rtemp_arr(2,:)), "netcdf_read_particle_info_system nf90_getvar origin_vhy_varid" ) - else if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then - call check( nf90_get_var(iu%ncid, iu%vhy_varid, rtemp_arr(2,:)), "netcdf_read_particle_info_system nf90_getvar vhy_varid" ) - else - rtemp_arr(2,:) = 0._DP - end if - - status = nf90_inq_varid(iu%ncid, ORIGIN_VHZ_VARNAME, iu%origin_vhz_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(iu%ncid, iu%origin_vhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar origin_vhz_varid" ) - else if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then - call check( nf90_get_var(iu%ncid, iu%vhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar vhz_varid" ) - else - rtemp_arr(3,:) = 0._DP - end if - do i = 1, npl - call pl%info(i)%set_value(origin_vh=rtemp_arr(:,plind(i))) + 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=rtemp_arr(:,tpind(i))) + call tp%info(i)%set_value(origin_vh=vectemp(:,tpind(i))) end do - status = nf90_inq_varid(iu%ncid, COLLISION_ID_VARNAME, iu%collision_id_varid) + status = nf90_inq_varid(nciu%id, nciu%collision_id_varname, nciu%collision_id_varid) if (status == nf90_noerr) then - call check( nf90_get_var(iu%ncid, iu%collision_id_varid, itemp), "netcdf_read_particle_info_system nf90_getvar collision_id_varid" ) + call check( nf90_get_var(nciu%id, nciu%collision_id_varid, itemp), "netcdf_read_particle_info_system nf90_getvar collision_id_varid" ) else itemp = 0.0_DP end if @@ -1074,9 +962,9 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma call tp%info(i)%set_value(collision_id=itemp(tpind(i))) end do - status = nf90_inq_varid(iu%ncid, DISCARD_TIME_VARNAME, iu%discard_time_varid) + status = nf90_inq_varid(nciu%id, nciu%discard_time_varname, nciu%discard_time_varid) if (status == nf90_noerr) then - call check( nf90_get_var(iu%ncid, iu%discard_time_varid, rtemp), "netcdf_read_particle_info_system nf90_getvar discard_time_varid" ) + call check( nf90_get_var(nciu%id, nciu%discard_time_varid, rtemp), "netcdf_read_particle_info_system nf90_getvar discard_time_varid" ) else rtemp = 0.0_DP end if @@ -1089,60 +977,32 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma call tp%info(i)%set_value(discard_time=rtemp(tpind(i))) end do - status = nf90_inq_varid(iu%ncid, DISCARD_XHX_VARNAME, iu%discard_xhx_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(iu%ncid, iu%discard_xhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar discard_xhx_varid" ) - else - rtemp_arr(1,:) = 0.0_DP - end if - - status = nf90_inq_varid(iu%ncid, DISCARD_XHY_VARNAME, iu%discard_xhy_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(iu%ncid, iu%discard_xhy_varid, rtemp_arr(2,:)), "netcdf_read_particle_info_system nf90_getvar discard_xhy_varid" ) - else - rtemp_arr(2,:) = 0.0_DP - end if - - status = nf90_inq_varid(iu%ncid, DISCARD_XHZ_VARNAME, iu%discard_xhz_varid) + status = nf90_inq_varid(nciu%id, nciu%discard_rh_varname, nciu%discard_rh_varid) if (status == nf90_noerr) then - call check( nf90_get_var(iu%ncid, iu%discard_xhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar discard_xhz_varid" ) + call check( nf90_get_var(nciu%id, nciu%discard_rh_varid, vectemp(:,:)), "netcdf_read_particle_info_system nf90_getvar discard_rh_varid" ) else - rtemp_arr(3,:) = 0.0_DP + vectemp(:,:) = 0.0_DP end if do i = 1, npl - call pl%info(i)%set_value(discard_xh=rtemp_arr(:,plind(i))) + call pl%info(i)%set_value(discard_rh=vectemp(:,plind(i))) end do do i = 1, ntp - call tp%info(i)%set_value(discard_xh=rtemp_arr(:,tpind(i))) + call tp%info(i)%set_value(discard_rh=vectemp(:,tpind(i))) end do - status = nf90_inq_varid(iu%ncid, DISCARD_VHX_VARNAME, iu%discard_vhx_varid) + status = nf90_inq_varid(nciu%id, nciu%discard_vh_varname, nciu%discard_vh_varid) if (status == nf90_noerr) then - 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(nciu%id, nciu%discard_vh_varid, vectemp(:,:)), "netcdf_read_particle_info_system nf90_getvar discard_vh_varid" ) else - rtemp_arr(1,:) = 0.0_DP - end if - - status = nf90_inq_varid(iu%ncid, DISCARD_VHY_VARNAME, iu%discard_vhy_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(iu%ncid, iu%discard_vhy_varid, rtemp_arr(2,:)), "netcdf_read_particle_info_system nf90_getvar discard_vhy_varid" ) - else - rtemp_arr(2,:) = 0.0_DP - end if - - status = nf90_inq_varid(iu%ncid, DISCARD_VHZ_VARNAME, iu%discard_vhz_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(iu%ncid, iu%discard_vhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar discard_vhz_varid" ) - else - rtemp_arr(3,:) = 0.0_DP + vectemp(:,:) = 0.0_DP end if do i = 1, npl - call pl%info(i)%set_value(discard_vh=rtemp_arr(:,plind(i))) + 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=rtemp_arr(:,tpind(i))) + call tp%info(i)%set_value(discard_vh=vectemp(:,tpind(i))) end do end if @@ -1161,13 +1021,13 @@ module subroutine netcdf_sync(self) ! 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" ) + call check( nf90_sync(self%id), "netcdf_sync nf90_sync" ) return end subroutine netcdf_sync - module subroutine netcdf_write_frame_base(self, iu, param) + module subroutine netcdf_write_frame_base(self, nciu, 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 @@ -1175,19 +1035,19 @@ module subroutine netcdf_write_frame_base(self, iu, param) 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(netcdf_parameters), intent(inout) :: nciu !! 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 + real(DP) :: a, e, inc, omega, capom, capm, varpi, lam, f, cape, capf - call self%write_particle_info(iu, param) + call self%write_info(nciu, param) - tslot = int(param%ioutput, kind=I4B) + 1 + tslot = param%ioutput + 1 - call check( nf90_set_fill(iu%ncid, nf90_nofill, old_mode), "netcdf_write_frame_base nf90_set_fill" ) + call check( nf90_set_fill(nciu%id, nf90_nofill, old_mode), "netcdf_write_frame_base nf90_set_fill" ) select type(self) class is (swiftest_body) associate(n => self%nbody) @@ -1200,63 +1060,59 @@ module subroutine netcdf_write_frame_base(self, iu, param) 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%lgr) call 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 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" ) + call check( nf90_put_var(nciu%id, nciu%rh_varid, self%rh(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "netcdf_write_frame_base nf90_put_var rh_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" ) + call check( nf90_put_var(nciu%id, nciu%vh_varid, vh(:), start=[1,idslot, tslot], count=[NDIM,1,1]), "netcdf_write_frame_base nf90_put_var vh_varid" ) + call check( nf90_put_var(nciu%id, nciu%gr_pseudo_vh_varid, self%vh(:, j), start=[1,idslot, tslot],count=[NDIM,1,1]), "netcdf_write_frame_base nf90_put_var gr_pseudo_vhx_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" ) + call check( nf90_put_var(nciu%id, nciu%vh_varid, self%vh(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "netcdf_write_frame_base 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 orbel_xv2el(self%mu(j), self%xh(1,j), self%xh(2,j), self%xh(3,j), & + call 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) + a, e, inc, capom, omega, capm, varpi, lam, f, cape, capf) 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), & + call 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) + a, e, inc, capom, omega, capm, varpi, lam, f, cape, capf) + end if + call check( nf90_put_var(nciu%id, nciu%a_varid, a, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body a_varid" ) + call check( nf90_put_var(nciu%id, nciu%e_varid, e, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body e_varid" ) + call check( nf90_put_var(nciu%id, nciu%inc_varid, inc * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body inc_varid" ) + call check( nf90_put_var(nciu%id, nciu%capom_varid, capom * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body capom_varid" ) + call check( nf90_put_var(nciu%id, nciu%omega_varid, omega * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body omega_varid" ) + call check( nf90_put_var(nciu%id, nciu%capm_varid, capm * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body capm_varid" ) + call check( nf90_put_var(nciu%id, nciu%varpi_varid, varpi * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body varpi_varid" ) + call check( nf90_put_var(nciu%id, nciu%lam_varid, lam * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body lam_varid" ) + call check( nf90_put_var(nciu%id, nciu%f_varid, f * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body f_varid" ) + if (e < 1.0_DP) then + call check( nf90_put_var(nciu%id, nciu%cape_varid, cape * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body cape_varid" ) + else if (e > 1.0_DP) then + call check( nf90_put_var(nciu%id, nciu%cape_varid, capf * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body (capf) cape_varid" ) 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" ) + call check( nf90_put_var(nciu%id, nciu%Gmass_varid, self%Gmass(j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body 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" ) + call check( nf90_put_var(nciu%id, nciu%rhill_varid, self%rhill(j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body 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%lclose) call check( nf90_put_var(nciu%id, nciu%radius_varid, self%radius(j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body 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" ) + call check( nf90_put_var(nciu%id, nciu%Ip_varid, self%Ip(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "netcdf_write_frame_base nf90_put_var body Ip_varid" ) + call check( nf90_put_var(nciu%id, nciu%rot_varid, self%rot(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "netcdf_write_frame_base nf90_put_var body rotx_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" ) + ! call check( nf90_put_var(nciu%id, nciu%k2_varid, self%k2(j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body k2_varid" ) + ! call check( nf90_put_var(nciu%id, nciu%Q_varid, self%Q(j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body Q_varid" ) ! end if end select @@ -1264,59 +1120,55 @@ module subroutine netcdf_write_frame_base(self, iu, param) 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(nciu%id, nciu%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" ) + call check( nf90_put_var(nciu%id, nciu%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(nciu%id, nciu%radius_varid, self%radius, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb radius_varid" ) + call check( nf90_put_var(nciu%id, nciu%j2rp2_varid, self%j2rp2, start=[tslot]), "netcdf_write_frame_base nf90_put_var cb j2rp2_varid" ) + call check( nf90_put_var(nciu%id, nciu%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" ) + call check( nf90_put_var(nciu%id, nciu%Ip_varid, self%Ip(:), start=[1, idslot, tslot], count=[NDIM,1,1]), "netcdf_write_frame_base nf90_put_var cb Ip_varid" ) + call check( nf90_put_var(nciu%id, nciu%rot_varid, self%rot(:), start=[1, idslot, tslot], count=[NDIM,1,1]), "netcdf_write_frame_base nf90_put_var cb rot_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" ) + ! call check( nf90_put_var(nciu%id, nciu%k2_varid, self%k2, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb k2_varid" ) + ! call check( nf90_put_var(nciu%id, nciu%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" ) + call check( nf90_set_fill(nciu%id, 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) + module subroutine netcdf_write_frame_system(self, nciu, 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(netcdf_parameters), intent(inout) :: nciu !! 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) + call self%write_hdr(nciu, param) + call self%cb%write_frame(nciu, param) + call self%pl%write_frame(nciu, param) + call self%tp%write_frame(nciu, param) return end subroutine netcdf_write_frame_system - module subroutine netcdf_write_particle_info_base(self, iu, param) + module subroutine netcdf_write_info_base(self, nciu, 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(netcdf_parameters), intent(inout) :: nciu !! 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 @@ -1324,7 +1176,7 @@ module subroutine netcdf_write_particle_info_base(self, iu, param) 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" ) + call check( nf90_set_fill(nciu%id, nf90_nofill, old_mode), "netcdf_write_info_base nf90_set_fill nf90_nofill" ) select type(self) class is (swiftest_body) @@ -1335,36 +1187,28 @@ module subroutine netcdf_write_particle_info_base(self, iu, param) 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" ) + call check( nf90_put_var(nciu%id, nciu%id_varid, self%id(j), start=[idslot]), "netcdf_write_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" ) + call check( nf90_put_var(nciu%id, nciu%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_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" ) + call check( nf90_put_var(nciu%id, nciu%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_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" ) + call check( nf90_put_var(nciu%id, nciu%status_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_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(nciu%id, nciu%origin_type_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_info_base nf90_put_var origin_type_varid" ) + call check( nf90_put_var(nciu%id, nciu%origin_time_varid, self%info(j)%origin_time, start=[idslot]), "netcdf_write_info_base nf90_put_var origin_time_varid" ) + call check( nf90_put_var(nciu%id, nciu%origin_rh_varid, self%info(j)%origin_rh(:), start=[1,idslot], count=[NDIM,1]), "netcdf_write_info_base nf90_put_var origin_rh_varid" ) + call check( nf90_put_var(nciu%id, nciu%origin_vh_varid, self%info(j)%origin_vh(:), start=[1,idslot], count=[NDIM,1]), "netcdf_write_info_base nf90_put_var origin_vh_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" ) + call check( nf90_put_var(nciu%id, nciu%collision_id_varid, self%info(j)%collision_id, start=[idslot]), "netcdf_write_info_base nf90_put_var collision_id_varid" ) + call check( nf90_put_var(nciu%id, nciu%discard_time_varid, self%info(j)%discard_time, start=[idslot]), "netcdf_write_info_base nf90_put_var discard_time_varid" ) + call check( nf90_put_var(nciu%id, nciu%discard_rh_varid, self%info(j)%discard_rh(:), start=[1,idslot], count=[NDIM,1]), "netcdf_write_info_base nf90_put_var discard_rh_varid" ) + call check( nf90_put_var(nciu%id, nciu%discard_vh_varid, self%info(j)%discard_vh(:), start=[1,idslot], count=[NDIM,1]), "netcdf_write_info_base nf90_put_var discard_vh_varid" ) end if end do @@ -1372,47 +1216,39 @@ module subroutine netcdf_write_particle_info_base(self, iu, param) 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" ) + call check( nf90_put_var(nciu%id, nciu%id_varid, self%id, start=[idslot]), "netcdf_write_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" ) + call check( nf90_put_var(nciu%id, nciu%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_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" ) + call check( nf90_put_var(nciu%id, nciu%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_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" ) + call check( nf90_put_var(nciu%id, nciu%status_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_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(nciu%id, nciu%origin_type_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_info_base nf90_put_var cb origin_type_varid" ) + + call check( nf90_put_var(nciu%id, nciu%origin_time_varid, self%info%origin_time, start=[idslot]), "netcdf_write_info_base nf90_put_var cb origin_time_varid" ) + call check( nf90_put_var(nciu%id, nciu%origin_rh_varid, self%info%origin_rh(:), start=[1, idslot], count=[NDIM,1]), "netcdf_write_info_base nf90_put_var cb origin_rh_varid" ) + call check( nf90_put_var(nciu%id, nciu%origin_vh_varid, self%info%origin_vh(:), start=[1, idslot], count=[NDIM,1]), "netcdf_write_info_base nf90_put_var cb origin_vh_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" ) + call check( nf90_put_var(nciu%id, nciu%collision_id_varid, self%info%collision_id, start=[idslot]), "netcdf_write_info_base nf90_put_var cb collision_id_varid" ) + call check( nf90_put_var(nciu%id, nciu%discard_time_varid, self%info%discard_time, start=[idslot]), "netcdf_write_info_base nf90_put_var cb discard_time_varid" ) + call check( nf90_put_var(nciu%id, nciu%discard_rh_varid, self%info%discard_rh(:), start=[1, idslot], count=[NDIM,1]), "netcdf_write_info_base nf90_put_var cb discard_rh_varid" ) + call check( nf90_put_var(nciu%id, nciu%discard_vh_varid, self%info%discard_vh(:), start=[1, idslot], count=[NDIM,1]), "netcdf_write_info_base nf90_put_var cb discard_vh_varid" ) end if end select - call check( nf90_set_fill(iu%ncid, old_mode, old_mode) ) + call check( nf90_set_fill(nciu%id, old_mode, old_mode) ) return - end subroutine netcdf_write_particle_info_base + end subroutine netcdf_write_info_base - module subroutine netcdf_write_hdr_system(self, iu, param) + module subroutine netcdf_write_hdr_system(self, nciu, param) !! author: David A. Minton !! !! Writes header information (variables that change with time, but not particle id). @@ -1421,37 +1257,31 @@ module subroutine netcdf_write_hdr_system(self, iu, param) 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(netcdf_parameters), intent(inout) :: nciu !! 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 + tslot = param%ioutput + 1 - call check( nf90_put_var(iu%ncid, iu%time_varid, self%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" ) + call check( nf90_put_var(nciu%id, nciu%time_varid, self%t, start=[tslot]), "netcdf_write_hdr_system nf90_put_var time_varid" ) + call check( nf90_put_var(nciu%id, nciu%npl_varid, self%pl%nbody, start=[tslot]), "netcdf_write_hdr_system nf90_put_var npl_varid" ) + call check( nf90_put_var(nciu%id, nciu%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" ) + call check( nf90_put_var(nciu%id, nciu%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" ) + call check( nf90_put_var(nciu%id, nciu%KE_orb_varid, self%ke_orbit, start=[tslot]), "netcdf_write_hdr_system nf90_put_var KE_orb_varid" ) + call check( nf90_put_var(nciu%id, nciu%KE_spin_varid, self%ke_spin, start=[tslot]), "netcdf_write_hdr_system nf90_put_var KE_spin_varid" ) + call check( nf90_put_var(nciu%id, nciu%PE_varid, self%pe, start=[tslot]), "netcdf_write_hdr_system nf90_put_var PE_varid" ) + call check( nf90_put_var(nciu%id, nciu%L_orb_varid, self%Lorbit(:), start=[1,tslot], count=[NDIM,1]), "netcdf_write_hdr_system nf90_put_var L_orb_varid" ) + call check( nf90_put_var(nciu%id, nciu%L_spin_varid, self%Lspin(:), start=[1,tslot], count=[NDIM,1]), "netcdf_write_hdr_system nf90_put_var L_spin_varid" ) + call check( nf90_put_var(nciu%id, nciu%L_escape_varid, self%Lescape(:), start=[1,tslot], count=[NDIM,1]), "netcdf_write_hdr_system nf90_put_var L_escape_varid" ) + call check( nf90_put_var(nciu%id, nciu%Ecollisions_varid, self%Ecollisions, start=[tslot]), "netcdf_write_hdr_system nf90_put_var Ecollisions_varid" ) + call check( nf90_put_var(nciu%id, nciu%Euntracked_varid, self%Euntracked, start=[tslot]), "netcdf_write_hdr_system nf90_put_var Euntracked_varid" ) + call check( nf90_put_var(nciu%id, nciu%GMescape_varid, self%GMescape, start=[tslot]), "netcdf_write_hdr_system nf90_put_var GMescape_varid" ) end if return diff --git a/src/obl/obl.f90 b/src/obl/obl.f90 index 9ae30a5e4..be964c3e5 100644 --- a/src/obl/obl.f90 +++ b/src/obl/obl.f90 @@ -31,17 +31,17 @@ module subroutine obl_acc_body(self, system) associate(n => self%nbody, cb => 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 @@ -137,7 +137,7 @@ module subroutine obl_pot_system(self) associate(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) = 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)) end associate diff --git a/src/orbel/orbel.f90 b/src/orbel/orbel.f90 index 5e7c4a989..0a4416160 100644 --- a/src/orbel/orbel.f90 +++ b/src/orbel/orbel.f90 @@ -28,7 +28,7 @@ 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)) + self%omega(i), self%capm(i), self%rh(:, i), self%vh(:, i)) end do return end subroutine orbel_el2xv_vec @@ -874,6 +874,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 @@ -885,17 +886,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 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 - pure module subroutine orbel_xv2el(mu, px, py, pz, vx, vy, vz, a, e, inc, capom, omega, capm) + pure module subroutine 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 @@ -921,9 +923,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 @@ -1023,6 +1030,18 @@ 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 diff --git a/src/rmvs/rmvs_discard.f90 b/src/rmvs/rmvs_discard.f90 index 60be2f6b0..1b3a58ddc 100644 --- a/src/rmvs/rmvs_discard.f90 +++ b/src/rmvs/rmvs_discard.f90 @@ -43,7 +43,7 @@ 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 diff --git a/src/rmvs/rmvs_encounter_check.f90 b/src/rmvs/rmvs_encounter_check.f90 index cf6b73624..860bcacfb 100644 --- a/src/rmvs/rmvs_encounter_check.f90 +++ b/src/rmvs/rmvs_encounter_check.f90 @@ -42,7 +42,7 @@ module function rmvs_encounter_check_tp(self, param, system, dt) result(lencount 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%xbeg, pl%vbeg, tp%rh, tp%vh, pl%renc, dt, & nenc, index1, index2, lvdotr) lencounter = (nenc > 0_I8B) diff --git a/src/rmvs/rmvs_kick.f90 b/src/rmvs/rmvs_kick.f90 index 91e63a62e..bb43aba94 100644 --- a/src/rmvs/rmvs_kick.f90 +++ b/src/rmvs/rmvs_kick.f90 @@ -42,11 +42,11 @@ module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) class is (rmvs_pl) select type (cb => 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 => system) system_planetocen%lbeg = lbeg ! Save the original heliocentric position for later - allocate(xh_original, source=tp%xh) + allocate(xh_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%xheliocentric(:,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%xheliocentric(:,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%xheliocentric(:, i) end do GMcb_original = cb%Gmass cb%Gmass = tp%cb_heliocentric%Gmass @@ -81,7 +81,7 @@ 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(xh_original, tp%rh) cb%Gmass = GMcb_original end associate diff --git a/src/rmvs/rmvs_step.f90 b/src/rmvs/rmvs_step.f90 index 7c39614e1..132139e33 100644 --- a/src/rmvs/rmvs_step.f90 +++ b/src/rmvs/rmvs_step.f90 @@ -38,7 +38,7 @@ module subroutine rmvs_step_system(self, param, t, dt) select type(tp => self%tp) class is (rmvs_tp) associate(system => self, ntp => tp%nbody, npl => pl%nbody) - allocate(xbeg, source=pl%xh) + allocate(xbeg, source=pl%rh) allocate(vbeg, source=pl%vh) call pl%set_beg_end(xbeg = xbeg, vbeg = vbeg) ! ****** Check for close encounters ***** ! @@ -49,7 +49,7 @@ module subroutine rmvs_step_system(self, param, t, dt) pl%outer(0)%x(:, 1:npl) = xbeg(:, 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) + 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) @@ -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)) @@ -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,9 +258,9 @@ 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(xh_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) @@ -317,7 +317,7 @@ 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) + pl%rh(:,1:npl) = pl%inner(inner_index)%x(:, 1:npl) call pl%accel_obl(system) pl%inner(inner_index)%aobl(:, 1:npl) = pl%aobl(:, 1:npl) end if @@ -329,7 +329,7 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) 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) + pl%rh(:, 1:npl) = pl%inner(NTPHENC)%x(:, 1:npl) call pl%accel_obl(system) pl%inner(NTPHENC)%aobl(:, 1:npl) = pl%aobl(:, 1:npl) end if @@ -339,7 +339,7 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) ! 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(xh_original)) call move_alloc(xh_original, pl%rh) if (allocated(ah_original)) call move_alloc(ah_original, pl%ah) end associate return @@ -388,7 +388,7 @@ 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) + plenci%rh(:, 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) @@ -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%xheliocentric(:, 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%xheliocentric(j, 1:nenci) = pack(tp%rh(j,1:ntp), encmask(:)) + tpenci%rh(j, 1:nenci) = tpenci%xheliocentric(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)) @@ -538,7 +538,7 @@ subroutine rmvs_peri_tp(tp, pl, t, dt, lfirst, inner_index, ipleP, param) 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 @@ -625,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/setup/setup.f90 b/src/setup/setup.f90 index 655d15b58..26aed237c 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -113,14 +113,14 @@ module subroutine setup_initialize_particle_info_system(self, param) 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]) + 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_xh=self%pl%xh(:,i), origin_vh=self%pl%vh(:,i)) + 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_xh=self%tp%xh(:,i), origin_vh=self%tp%vh(:,i)) + origin_time=param%t0, origin_rh=self%tp%rh(:,i), origin_vh=self%tp%vh(:,i)) end do end associate @@ -193,7 +193,7 @@ module subroutine setup_body(self, n, param) allocate(self%ldiscard(n)) allocate(self%lmask(n)) allocate(self%mu(n)) - allocate(self%xh(NDIM, n)) + allocate(self%rh(NDIM, n)) allocate(self%vh(NDIM, n)) allocate(self%xb(NDIM, n)) allocate(self%vb(NDIM, n)) @@ -210,10 +210,10 @@ module subroutine setup_body(self, n, param) origin_type = "UNKNOWN", & collision_id = 0, & origin_time = -huge(1.0_DP), & - origin_xh = [0.0_DP, 0.0_DP, 0.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_xh = [0.0_DP, 0.0_DP, 0.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 & ) @@ -223,7 +223,7 @@ module subroutine setup_body(self, n, param) self%ldiscard(:) = .false. self%lmask(:) = .false. self%mu(:) = 0.0_DP - self%xh(:,:) = 0.0_DP + self%rh(:,:) = 0.0_DP self%vh(:,:) = 0.0_DP self%xb(:,:) = 0.0_DP self%vb(:,:) = 0.0_DP diff --git a/src/setup/symba_collision.f90 b/src/setup/symba_collision.f90 index e839af1de..c4d04ee75 100644 --- a/src/setup/symba_collision.f90 +++ b/src/setup/symba_collision.f90 @@ -314,7 +314,7 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec do concurrent(k = 1:nenc, lmask(k)) i = self%index1(k) j = self%index2(k) - xr(:) = pl%xh(:, i) - pl%xh(:, j) + 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) @@ -325,7 +325,7 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec do concurrent(k = 1:nenc, lmask(k)) i = self%index1(k) j = self%index2(k) - xr(:) = pl%xh(:, i) - tp%xh(:, j) + xr(:) = pl%rh(:, i) - tp%rh(:, 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)) @@ -340,10 +340,10 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec 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%x1(:,k) = pl%rh(:,i) + system%cb%xb(:) self%v1(:,k) = pl%vb(:,i) if (isplpl) then - self%x2(:,k) = pl%xh(:,j) + system%cb%xb(:) + self%x2(:,k) = pl%rh(:,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 @@ -352,11 +352,11 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec ! 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)) + call pl%info(i)%set_value(status="COLLISION", discard_time=t, discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i)) + call pl%info(j)%set_value(status="COLLISION", discard_time=t, discard_rh=pl%rh(:,j), discard_vh=pl%vh(:,j)) end if else - self%x2(:,k) = tp%xh(:,j) + system%cb%xb(:) + self%x2(:,k) = tp%rh(:,j) + system%cb%xb(:) self%v2(:,k) = tp%vb(:,j) if (lcollision(k)) then tp%status(j) = DISCARDED_PLR @@ -364,7 +364,7 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec 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)) + 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)) @@ -508,7 +508,7 @@ function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, collid ! 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%xb(:, j) = pl%rh(:, 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 @@ -521,7 +521,7 @@ function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, collid 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(:) + xchild(:) = pl%rh(:, 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 @@ -747,7 +747,7 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) call pl%vb2vh(cb) call pl%xh2xb(cb) do i = 1, nfrag - plnew%xh(:,i) = frag%xb(:, i) - cb%xb(:) + plnew%rh(:,i) = frag%xb(:, i) - cb%xb(:) plnew%vh(:,i) = frag%vb(:, i) - cb%vb(:) end do plnew%mass(1:nfrag) = frag%mass(1:nfrag) @@ -762,7 +762,7 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) do i = 1, nfrag write(newname, FRAGFMT) frag%id(i) call plnew%info(i)%set_value(origin_type="Disruption", origin_time=system%t, name=newname, & - origin_xh=plnew%xh(:,i), & + origin_rh=plnew%rh(:,i), & origin_vh=plnew%vh(:,i), collision_id=param%maxid_collision) end do do i = 1, ncolliders @@ -772,14 +772,14 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) iother = ibiggest end if call pl%info(colliders%idx(i))%set_value(status="Disruption", discard_time=system%t, & - discard_xh=pl%xh(:,i), discard_vh=pl%vh(:,i), discard_body_id=iother) + discard_rh=pl%rh(:,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=system%t, name=newname, & - origin_xh=plnew%xh(:,i), origin_vh=plnew%vh(:,i), & + origin_rh=plnew%rh(:,i), origin_vh=plnew%vh(:,i), & collision_id=param%maxid_collision) end do do i = 1, ncolliders @@ -789,7 +789,7 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) iother = ibiggest end if call pl%info(colliders%idx(i))%set_value(status="Supercatastrophic", discard_time=system%t, & - discard_xh=pl%xh(:,i), discard_vh=pl%vh(:,i), & + discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), & discard_body_id=iother) end do case(HIT_AND_RUN_DISRUPT) @@ -798,14 +798,14 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) do i = 2, nfrag write(newname, FRAGFMT) frag%id(i) call plnew%info(i)%set_value(origin_type="Hit and run fragment", origin_time=system%t, name=newname, & - origin_xh=plnew%xh(:,i), origin_vh=plnew%vh(:,i), & + origin_rh=plnew%rh(:,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=system%t, & - discard_xh=pl%xh(:,i), discard_vh=pl%vh(:,i), & + discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), & discard_body_id=iother) end do case(MERGED) @@ -815,7 +815,7 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) if (colliders%idx(i) == ibiggest) cycle iother = ibiggest - call pl%info(colliders%idx(i))%set_value(status="MERGED", discard_time=system%t, discard_xh=pl%xh(:,i), & + call pl%info(colliders%idx(i))%set_value(status="MERGED", discard_time=system%t, discard_rh=pl%rh(:,i), & discard_vh=pl%vh(:,i), discard_body_id=iother) end do end select diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index e839af1de..06c474078 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -314,7 +314,7 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec do concurrent(k = 1:nenc, lmask(k)) i = self%index1(k) j = self%index2(k) - xr(:) = pl%xh(:, i) - pl%xh(:, j) + 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) @@ -325,7 +325,7 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec do concurrent(k = 1:nenc, lmask(k)) i = self%index1(k) j = self%index2(k) - xr(:) = pl%xh(:, i) - tp%xh(:, j) + xr(:) = pl%rh(:, i) - tp%rh(:, 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)) @@ -339,11 +339,11 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec 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%tcollision(k) = t + self%x1(:,k) = pl%rh(:,i) + system%cb%xb(:) self%v1(:,k) = pl%vb(:,i) if (isplpl) then - self%x2(:,k) = pl%xh(:,j) + system%cb%xb(:) + self%x2(:,k) = pl%rh(:,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 @@ -352,11 +352,11 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec ! 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)) + call pl%info(i)%set_value(status="COLLISION", discard_time=t, discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i)) + call pl%info(j)%set_value(status="COLLISION", discard_time=t, discard_rh=pl%rh(:,j), discard_vh=pl%vh(:,j)) end if else - self%x2(:,k) = tp%xh(:,j) + system%cb%xb(:) + self%x2(:,k) = tp%rh(:,j) + system%cb%xb(:) self%v2(:,k) = tp%vb(:,j) if (lcollision(k)) then tp%status(j) = DISCARDED_PLR @@ -364,7 +364,7 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec 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)) + 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)) @@ -508,7 +508,7 @@ function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, collid ! 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%xb(:, j) = pl%rh(:, 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 @@ -521,7 +521,7 @@ function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, collid 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(:) + xchild(:) = pl%rh(:, 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 @@ -747,7 +747,7 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) call pl%vb2vh(cb) call pl%xh2xb(cb) do i = 1, nfrag - plnew%xh(:,i) = frag%xb(:, i) - cb%xb(:) + plnew%rh(:,i) = frag%xb(:, i) - cb%xb(:) plnew%vh(:,i) = frag%vb(:, i) - cb%vb(:) end do plnew%mass(1:nfrag) = frag%mass(1:nfrag) @@ -762,7 +762,7 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) do i = 1, nfrag write(newname, FRAGFMT) frag%id(i) call plnew%info(i)%set_value(origin_type="Disruption", origin_time=system%t, name=newname, & - origin_xh=plnew%xh(:,i), & + origin_rh=plnew%rh(:,i), & origin_vh=plnew%vh(:,i), collision_id=param%maxid_collision) end do do i = 1, ncolliders @@ -772,14 +772,14 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) iother = ibiggest end if call pl%info(colliders%idx(i))%set_value(status="Disruption", discard_time=system%t, & - discard_xh=pl%xh(:,i), discard_vh=pl%vh(:,i), discard_body_id=iother) + discard_rh=pl%rh(:,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=system%t, name=newname, & - origin_xh=plnew%xh(:,i), origin_vh=plnew%vh(:,i), & + origin_rh=plnew%rh(:,i), origin_vh=plnew%vh(:,i), & collision_id=param%maxid_collision) end do do i = 1, ncolliders @@ -789,7 +789,7 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) iother = ibiggest end if call pl%info(colliders%idx(i))%set_value(status="Supercatastrophic", discard_time=system%t, & - discard_xh=pl%xh(:,i), discard_vh=pl%vh(:,i), & + discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), & discard_body_id=iother) end do case(HIT_AND_RUN_DISRUPT) @@ -798,14 +798,14 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) do i = 2, nfrag write(newname, FRAGFMT) frag%id(i) call plnew%info(i)%set_value(origin_type="Hit and run fragment", origin_time=system%t, name=newname, & - origin_xh=plnew%xh(:,i), origin_vh=plnew%vh(:,i), & + origin_rh=plnew%rh(:,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=system%t, & - discard_xh=pl%xh(:,i), discard_vh=pl%vh(:,i), & + discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), & discard_body_id=iother) end do case(MERGED) @@ -815,7 +815,7 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) if (colliders%idx(i) == ibiggest) cycle iother = ibiggest - call pl%info(colliders%idx(i))%set_value(status="MERGED", discard_time=system%t, discard_xh=pl%xh(:,i), & + call pl%info(colliders%idx(i))%set_value(status="MERGED", discard_time=system%t, discard_rh=pl%rh(:,i), & discard_vh=pl%vh(:,i), discard_body_id=iother) end do end select diff --git a/src/symba/symba_discard.f90 b/src/symba/symba_discard.f90 index 76bcbaf41..a380487f7 100644 --- a/src/symba/symba_discard.f90 +++ b/src/symba/symba_discard.f90 @@ -38,7 +38,7 @@ subroutine symba_discard_cb_pl(pl, system, param) 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. @@ -54,7 +54,7 @@ subroutine symba_discard_cb_pl(pl, system, param) call io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & "***********************************************************") call io_log_one_message(FRAGGLE_LOG_OUT, "") - call pl%info(i)%set_value(status="DISCARDED_RMAX", discard_time=system%t, discard_xh=pl%xh(:,i), & + call pl%info(i)%set_value(status="DISCARDED_RMAX", discard_time=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. @@ -71,7 +71,7 @@ subroutine symba_discard_cb_pl(pl, system, param) call io_log_one_message(FRAGGLE_LOG_OUT, "************************************************************" // & "************************************************************") call io_log_one_message(FRAGGLE_LOG_OUT, "") - call pl%info(i)%set_value(status="DISCARDED_RMIN", discard_time=system%t, discard_xh=pl%xh(:,i), & + call pl%info(i)%set_value(status="DISCARDED_RMIN", discard_time=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)) @@ -92,7 +92,7 @@ subroutine symba_discard_cb_pl(pl, system, param) call io_log_one_message(FRAGGLE_LOG_OUT, "************************************************************" // & "************************************************************") call io_log_one_message(FRAGGLE_LOG_OUT, "") - call pl%info(i)%set_value(status="DISCARDED_RMAXU", discard_time=system%t, discard_xh=pl%xh(:,i), & + call pl%info(i)%set_value(status="DISCARDED_RMAXU", discard_time=system%t, discard_rh=pl%rh(:,i), & discard_vh=pl%vh(:,i)) end if end if @@ -330,7 +330,7 @@ subroutine symba_discard_peri_pl(pl, system, param) 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=system%t, & - discard_xh=pl%xh(:,i), discard_vh=pl%vh(:,i), discard_body_id=system%cb%id) + discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), discard_body_id=system%cb%id) end if end if end if diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index 48672142e..e58da2129 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -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, plplenc_list => system%plplenc_list, cb => system%cb, ienc_frame => system%ienc_frame) npl = pl%nbody nplm = pl%nplm @@ -43,9 +43,9 @@ 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%vb, 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%vb(:,1:nplm), pl%xh(:,nplm+1:npl), & + 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 @@ -57,7 +57,7 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l call move_alloc(index2, plplenc_list%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) @@ -65,6 +65,10 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l plplenc_list%id2(k) = pl%id(j) plplenc_list%status(k) = ACTIVE plplenc_list%level(k) = irec + plplenc_list%x1(:,k) = pl%rh(:,i) + plplenc_list%x2(:,k) = pl%rh(:,j) + plplenc_list%v1(:,k) = pl%vb(:,i) - cb%vb(:) + plplenc_list%v2(:,k) = pl%vb(:,j) - cb%vb(:) pl%lencounter(i) = .true. pl%lencounter(j) = .true. pl%levelg(i) = irec @@ -85,7 +89,7 @@ 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. + !! Check for an encounter between test particles and massive bodies in the plplenc and 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 @@ -103,7 +107,7 @@ module function symba_encounter_check(self, param, system, dt, irec) result(lany 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 @@ -126,16 +130,16 @@ module function symba_encounter_check(self, param, system, dt, irec) result(lany call pl%set_renc(irec) - allocate(encidx(nenc_enc)) + allocate(eidx(nenc_enc)) allocate(lencounter(nenc_enc)) - encidx(:) = pack([(k, k = 1, self%nenc)], lencmask(:)) + eidx(:) = pack([(k, k = 1, self%nenc)], lencmask(:)) lencounter(:) = .false. if (isplpl) then do concurrent(lidx = 1:nenc_enc) - k = encidx(lidx) + k = eidx(lidx) i = self%index1(k) j = self%index2(k) - xr(:) = pl%xh(:,j) - pl%xh(:,i) + 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)) @@ -147,10 +151,10 @@ module function symba_encounter_check(self, param, system, dt, irec) result(lany end do else do concurrent(lidx = 1:nenc_enc) - k = encidx(lidx) + k = eidx(lidx) i = self%index1(k) j = self%index2(k) - xr(:) = tp%xh(:,j) - pl%xh(:,i) + 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)) @@ -164,9 +168,9 @@ module function symba_encounter_check(self, param, system, dt, irec) result(lany lany_encounter = any(lencounter(:)) if (lany_encounter) then nenc_enc = count(lencounter(:)) - encidx(1:nenc_enc) = pack(encidx(:), lencounter(:)) + eidx(1:nenc_enc) = pack(eidx(:), lencounter(:)) do lidx = 1, nenc_enc - k = encidx(lidx) + k = eidx(lidx) i = self%index1(k) j = self%index2(k) pl%levelg(i) = irec @@ -213,7 +217,7 @@ module function symba_encounter_check_tp(self, param, system, dt, irec) result(l associate(tp => self, ntp => self%nbody, pl => system%pl, npl => system%pl%nbody) call pl%set_renc(irec) - call encounter_check_all_pltp(param, npl, ntp, pl%xh, pl%vb, tp%xh, tp%vb, 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 diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index d5dd06308..9cfd8ba9a 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -63,6 +63,9 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms read(param_value, *) param%GMTINY case ("MIN_GMFRAG") read(param_value, *) param%min_GMfrag + case ("ENCOUNTER_SAVE") + call 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 @@ -113,6 +116,13 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms ! 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") + if ((param%encounter_save /= "NONE") .and. (param%encounter_save /= "ALL") .and. (param%encounter_save /= "FRAGMENTATION")) then + write(iomsg,*) 'Invalid encounter_save parameter: ',trim(adjustl(param%out_type)) + write(iomsg,*) 'Valid options are NONE, ALL, or FRAGMENTATION' + iostat = -1 + return + end if + ! Call the base method (which also prints the contents to screen) call io_param_reader(param, unit, iotype, v_list, iostat, iomsg) end associate @@ -177,12 +187,12 @@ module subroutine symba_io_write_discard(self, param) associate(pl => self%pl, npl => self%pl%nbody, pl_adds => self%pl_adds) - if (self%tp_discards%nbody > 0) call self%tp_discards%write_particle_info(param%nciu, param) + if (self%tp_discards%nbody > 0) call self%tp_discards%write_info(param%nciu, param) select type(pl_discards => self%pl_discards) class is (symba_merger) if (pl_discards%nbody == 0) return - call pl_discards%write_particle_info(param%nciu, param) + call pl_discards%write_info(param%nciu, param) end select end associate diff --git a/src/symba/symba_kick.f90 b/src/symba/symba_kick.f90 index 476fd1697..114160f9a 100644 --- a/src/symba/symba_kick.f90 +++ b/src/symba/symba_kick.f90 @@ -42,9 +42,9 @@ module subroutine symba_kick_getacch_int_pl(self, param) 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) + call kick_getacch_int_all_flat_pl(self%nbody, self%nplplm, self%k_plpl, self%rh, 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) + call 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 @@ -87,7 +87,7 @@ module subroutine symba_kick_getacch_pl(self, system, param, t, lbeg) 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) + call 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 @@ -129,9 +129,9 @@ module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) j = pltpenc_list%index2(k) if (tp%lmask(j)) then if (lbeg) then - dx(:) = tp%xh(:,j) - pl%xbeg(:,i) + dx(:) = tp%rh(:,j) - pl%xbeg(:,i) else - dx(:) = tp%xh(:,j) - pl%xend(:,i) + dx(:) = tp%rh(:,j) - pl%xend(:,i) end if rjj = dot_product(dx(:), dx(:)) fac = pl%Gmass(i) / (rjj * sqrt(rjj)) @@ -232,11 +232,11 @@ module subroutine symba_kick_encounter(self, system, dt, irec, sgn) 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) + dx(:) = pl%rh(:,j) - pl%rh(:,i) else ri = ((pl%rhill(i))**2) * (RHSCALE**2) * (RSHELL**(2*irecl)) rim1 = ri * (RSHELL**2) - dx(:) = tp%xh(:,j) - pl%xh(:,i) + dx(:) = tp%rh(:,j) - pl%rh(:,i) end if r2 = dot_product(dx(:), dx(:)) if (r2 < rim1) then diff --git a/src/symba/symba_setup.f90 b/src/symba/symba_setup.f90 index 9187e4457..9a4ace98f 100644 --- a/src/symba/symba_setup.f90 +++ b/src/symba/symba_setup.f90 @@ -120,9 +120,12 @@ module subroutine symba_setup_encounter_list(self, n) if (n <= 0_I8B) return if (allocated(self%level)) deallocate(self%level) + if (allocated(self%tcollision)) deallocate(self%tcollision) allocate(self%level(n)) + allocate(self%tcollision(n)) self%level(:) = -1 + self%tcollision(:) = 0.0_DP return end subroutine symba_setup_encounter_list diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index e24eeec31..ecf1874f6 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -38,6 +38,7 @@ module subroutine symba_step_system(self, param, t, dt) 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) + !call self%encounter_history%dump(param) else self%irec = -1 call helio_step_system(self, param, t, dt) @@ -275,6 +276,8 @@ module subroutine symba_step_reset_system(self, param) nenc_old = system%plplenc_list%nenc call system%plplenc_list%setup(0_I8B) call system%plplcollision_list%setup(0_I8B) + system%ienc_frame = 0 + if (allocated(system%encounter_history)) deallocate(system%encounter_history) if (npl > 0) then pl%lcollision(1:npl) = .false. call pl%reset_kinship([(i, i=1, npl)]) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index f0f300bc1..621287433 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -183,6 +183,7 @@ module subroutine symba_util_copy_encounter_list(self, source) class is (symba_encounter) associate(n => source%nenc) self%level(1:n) = source%level(1:n) + self%tcollision(1:n) = source%tcollision(1:n) end associate end select @@ -201,6 +202,7 @@ module subroutine symba_util_dealloc_encounter_list(self) class(symba_encounter), intent(inout) :: self !! SyMBA encounter list if (allocated(self%level)) deallocate(self%level) + if (allocated(self%tcollision)) deallocate(self%tcollision) return end subroutine symba_util_dealloc_encounter_list @@ -532,7 +534,7 @@ module subroutine symba_util_peri_pl(self, system, param) 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)) + vdotr = dot_product(pl%rh(:,i), pl%vh(:,i)) if (vdotr > 0.0_DP) then pl%isperi(i) = 1 else @@ -556,11 +558,11 @@ module subroutine symba_util_peri_pl(self, system, param) 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)) + vdotr = dot_product(pl%rh(:,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), & + CALL orbel_xv2aeq(pl%mu(i), pl%rh(1,i), pl%rh(2,i), pl%rh(3,i), pl%vh(1,i), pl%vh(2,i), pl%vh(3,i), & pl%atp(i), e, pl%peri(i)) end if else @@ -678,7 +680,7 @@ module subroutine symba_util_rearray_pl(self, system, param) end where end select - call pl%write_particle_info(param%nciu, param) + call pl%write_info(param%nciu, param) deallocate(ldump_mask) ! Reindex the new list of bodies @@ -724,21 +726,33 @@ module subroutine symba_util_rearray_pl(self, system, param) ! 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%Gmass1(k) = plplenc_old%Gmass1(k) + system%plplenc_list%Gmass2(k) = plplenc_old%Gmass2(k) + system%plplenc_list%radius1(k) = plplenc_old%radius1(k) + system%plplenc_list%radius2(k) = plplenc_old%radius2(k) + system%plplenc_list%name1(k) = plplenc_old%name1(k) + system%plplenc_list%name2(k) = plplenc_old%name2(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%tcollision(k) = plplenc_old%tcollision(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%Gmass1(k) = plplenc_old%Gmass2(k) + system%plplenc_list%Gmass2(k) = plplenc_old%Gmass1(k) + system%plplenc_list%radius1(k) = plplenc_old%radius2(k) + system%plplenc_list%radius2(k) = plplenc_old%radius1(k) + system%plplenc_list%name1(k) = plplenc_old%name2(k) + system%plplenc_list%name2(k) = plplenc_old%name1(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%tcollision(k) = plplenc_old%tcollision(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) @@ -761,7 +775,13 @@ module subroutine symba_util_rearray_pl(self, system, param) 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%Gmass1(1:nencmin) = pack(system%plplenc_list%Gmass1(1:nenc_old), lmask(1:nenc_old)) + system%plplenc_list%Gmass2(1:nencmin) = pack(system%plplenc_list%Gmass2(1:nenc_old), lmask(1:nenc_old)) + system%plplenc_list%radius1(1:nencmin) = pack(system%plplenc_list%radius1(1:nenc_old), lmask(1:nenc_old)) + system%plplenc_list%radius2(1:nencmin) = pack(system%plplenc_list%radius2(1:nenc_old), lmask(1:nenc_old)) + system%plplenc_list%name1(1:nencmin) = pack(system%plplenc_list%name1(1:nenc_old), lmask(1:nenc_old)) + system%plplenc_list%name2(1:nencmin) = pack(system%plplenc_list%name2(1:nenc_old), lmask(1:nenc_old)) + system%plplenc_list%tcollision(1:nencmin) = pack(system%plplenc_list%tcollision(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)) @@ -880,6 +900,46 @@ module subroutine symba_util_resize_pl(self, nnew) end subroutine symba_util_resize_pl + module subroutine symba_util_resize_storage(self, nnew) + !! 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(symba_nbody_system), intent(inout) :: self !! Swiftest encounter list + integer(I4B), intent(in) :: nnew !! New size of list needed + ! Internals + type(encounter_storage(nframes=:)), allocatable :: tmp + integer(I4B) :: i, nold + logical :: lmalloc + + + lmalloc = allocated(self%encounter_history) + if (lmalloc) then + nold = self%encounter_history%nframes + else + nold = 0 + end if + + if (nnew > nold) then + allocate(encounter_storage(8 * nnew) :: tmp) + if (lmalloc) then + do i = 1, nold + if (allocated(self%encounter_history%frame(i)%item)) tmp%frame(i) = self%encounter_history%frame(i)%item + end do + deallocate(self%encounter_history) + end if + call move_alloc(tmp,self%encounter_history) + end if + + return + end subroutine symba_util_resize_storage + + + module subroutine symba_util_resize_tp(self, nnew) !! author: David A. Minton !! diff --git a/src/tides/tides_getacch_pl.f90 b/src/tides/tides_getacch_pl.f90 index 4feb76221..c37e84b88 100644 --- a/src/tides/tides_getacch_pl.f90 +++ b/src/tides/tides_getacch_pl.f90 @@ -29,9 +29,9 @@ module subroutine tides_kick_getacch_pl(self, system) pl%atide(:,:) = 0.0_DP cb%atide(:) = 0.0_DP do i = 1, npl - rmag = norm2(pl%xh(:,i)) + rmag = norm2(pl%rh(:,i)) vmag = norm2(pl%vh(:,i)) - r_unit(:) = pl%xh(:,i) / rmag + 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(:) diff --git a/src/util/util_append.f90 b/src/util/util_append.f90 index d59704374..a02b28f2b 100644 --- a/src/util/util_append.f90 +++ b/src/util/util_append.f90 @@ -209,7 +209,7 @@ module subroutine util_append_body(self, source, 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%rh, source%rh, 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) diff --git a/src/util/util_coord.f90 b/src/util/util_coord.f90 index 21b57844d..98a5549ac 100644 --- a/src/util/util_coord.f90 +++ b/src/util/util_coord.f90 @@ -35,14 +35,14 @@ module subroutine util_coord_h2b_pl(self, cb) do i = 1, npl if (pl%status(i) == INACTIVE) cycle Gmtot = Gmtot + pl%Gmass(i) - xtmp(:) = xtmp(:) + pl%Gmass(i) * pl%xh(:,i) + xtmp(:) = xtmp(:) + pl%Gmass(i) * pl%rh(:,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%xb(:,i) = pl%rh(:,i) + cb%xb(:) pl%vb(:,i) = pl%vh(:,i) + cb%vb(:) end do end associate @@ -68,7 +68,7 @@ module subroutine util_coord_h2b_tp(self, cb) 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%xb(:, i) = tp%rh(:, i) + cb%xb(:) tp%vb(:, i) = tp%vh(:, i) + cb%vb(:) end do end associate @@ -95,7 +95,7 @@ module subroutine util_coord_b2h_pl(self, cb) associate(pl => self, npl => self%nbody) do concurrent (i = 1:npl, pl%status(i) /= INACTIVE) - pl%xh(:, i) = pl%xb(:, i) - cb%xb(:) + pl%rh(:, i) = pl%xb(:, i) - cb%xb(:) pl%vh(:, i) = pl%vb(:, i) - cb%vb(:) end do end associate @@ -122,7 +122,7 @@ module subroutine util_coord_b2h_tp(self, cb) associate(tp => self, ntp => self%nbody) do concurrent(i = 1:ntp, tp%status(i) /= INACTIVE) - tp%xh(:, i) = tp%xb(:, i) - cb%xb(:) + tp%rh(:, i) = tp%xb(:, i) - cb%xb(:) tp%vh(:, i) = tp%vb(:, i) - cb%vb(:) end do end associate @@ -246,7 +246,7 @@ module subroutine util_coord_vh2vb_tp(self, vbcb) end subroutine util_coord_vh2vb_tp - module subroutine util_coord_xh2xb_pl(self, cb) + module subroutine util_coord_rh2xb_pl(self, cb) !! author: David A. Minton !! !! Convert position vectors of massive bodies from heliocentric to barycentric coordinates (position only) @@ -269,20 +269,20 @@ module subroutine util_coord_xh2xb_pl(self, cb) do i = 1, npl if (pl%status(i) == INACTIVE) cycle Gmtot = Gmtot + pl%Gmass(i) - xtmp(:) = xtmp(:) + pl%Gmass(i) * pl%xh(:,i) + xtmp(:) = xtmp(:) + pl%Gmass(i) * pl%rh(:,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(:) + pl%xb(:,i) = pl%rh(:,i) + cb%xb(:) end do end associate return - end subroutine util_coord_xh2xb_pl + end subroutine util_coord_rh2xb_pl - module subroutine util_coord_xh2xb_tp(self, cb) + module subroutine util_coord_rh2xb_tp(self, cb) !! author: David A. Minton !! !! Convert test particles from heliocentric to barycentric coordinates (position only) @@ -299,11 +299,11 @@ module subroutine util_coord_xh2xb_tp(self, cb) 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%xb(:, i) = tp%rh(:, i) + cb%xb(:) end do end associate return - end subroutine util_coord_xh2xb_tp + end subroutine util_coord_rh2xb_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 index 51e210787..bef861d07 100644 --- a/src/util/util_copy.f90 +++ b/src/util/util_copy.f90 @@ -26,10 +26,10 @@ module subroutine util_copy_particle_info(self, source) origin_type = source%origin_type, & origin_time = source%origin_time, & collision_id = source%collision_id, & - origin_xh = source%origin_xh(:), & + origin_rh = source%origin_rh(:), & origin_vh = source%origin_vh(:), & discard_time = source%discard_time, & - discard_xh = source%discard_xh(:), & + discard_rh = source%discard_rh(:), & discard_vh = source%discard_vh(:), & discard_body_id = source%discard_body_id & ) @@ -78,18 +78,18 @@ module subroutine util_copy_particle_info_arr(source, dest, idx) end subroutine util_copy_particle_info_arr - module subroutine util_copy_store_system(self, system) + module subroutine util_copy_store(self, source) !! author: David A. Minton !! !! Stores a snapshot of the nbody system so that later it can be retrieved for saving to file. implicit none - class(storage_frame), intent(inout) :: self !! Swiftest storage frame object - class(swiftest_nbody_system), intent(in) :: system !! Swiftest n-body system object + class(swiftest_storage_frame), intent(inout) :: self !! Swiftest storage frame object + class(*), intent(in) :: source !! Swiftest n-body system object - if (allocated(self%system)) deallocate(self%system) - allocate(self%system, source=system) + if (allocated(self%item)) deallocate(self%item) + allocate(self%item, source=source) + return - - end subroutine util_copy_store_system + end subroutine util_copy_store end submodule s_util_copy diff --git a/src/util/util_dealloc.f90 b/src/util/util_dealloc.f90 index 107a7c478..b3fb38fd9 100644 --- a/src/util/util_dealloc.f90 +++ b/src/util/util_dealloc.f90 @@ -25,7 +25,7 @@ module subroutine util_dealloc_body(self) 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%rh)) deallocate(self%rh) if (allocated(self%vh)) deallocate(self%vh) if (allocated(self%xb)) deallocate(self%xb) if (allocated(self%vb)) deallocate(self%vb) diff --git a/src/util/util_fill.f90 b/src/util/util_fill.f90 index deb78f4ee..9b542d19c 100644 --- a/src/util/util_fill.f90 +++ b/src/util/util_fill.f90 @@ -160,7 +160,7 @@ module subroutine util_fill_body(self, inserts, 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%rh, inserts%rh, 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) diff --git a/src/util/util_peri.f90 b/src/util/util_peri.f90 index bed29c58a..badd0e328 100644 --- a/src/util/util_peri.f90 +++ b/src/util/util_peri.f90 @@ -34,11 +34,11 @@ module subroutine util_peri_tp(self, system, param) allocate(vdotr(ntp)) if (param%qmin_coord == "HELIO") then do i = 1, ntp - vdotr(i) = dot_product(tp%xh(:, i), tp%vh(:, i)) + vdotr(i) = dot_product(tp%rh(:, 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), & + call orbel_xv2aeq(tp%mu(i), tp%rh(1,i), tp%rh(2,i), tp%rh(3,i), tp%vh(1,i), tp%vh(2,i), tp%vh(3,i), & tp%atp(i), e, tp%peri(i)) end if else diff --git a/src/util/util_rescale.f90 b/src/util/util_rescale.f90 index 482089859..deb3e0e1e 100644 --- a/src/util/util_rescale.f90 +++ b/src/util/util_rescale.f90 @@ -48,7 +48,7 @@ module subroutine util_rescale_system(self, param, mscale, dscale, 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%rh(:,1:npl) = pl%rh(:,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 diff --git a/src/util/util_resize.f90 b/src/util/util_resize.f90 index 01cf544ac..eee6b0e4c 100644 --- a/src/util/util_resize.f90 +++ b/src/util/util_resize.f90 @@ -297,7 +297,7 @@ module subroutine util_resize_body(self, 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%rh, nnew) call util_resize(self%vh, nnew) call util_resize(self%xb, nnew) call util_resize(self%vb, nnew) diff --git a/src/util/util_set.f90 b/src/util/util_set.f90 index 1a67efcbe..05e4b41f9 100644 --- a/src/util/util_set.f90 +++ b/src/util/util_set.f90 @@ -53,7 +53,7 @@ module subroutine util_set_ir3h(self) if (self%nbody > 0) then do i = 1, self%nbody - r2 = dot_product(self%xh(:, i), self%xh(:, i)) + r2 = dot_product(self%rh(:, i), self%rh(:, i)) irh = 1.0_DP / sqrt(r2) self%ir3h(i) = irh / r2 end do @@ -107,8 +107,8 @@ module subroutine util_set_mu_tp(self, cb) 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) + module subroutine 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 @@ -121,10 +121,10 @@ module subroutine util_set_particle_info(self, name, particle_type, status, orig 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_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_xh !! The heliocentric distance vector at 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 @@ -152,8 +152,8 @@ module subroutine util_set_particle_info(self, name, particle_type, status, orig if (present(collision_id)) then self%collision_id = collision_id end if - if (present(origin_xh)) then - self%origin_xh(:) = origin_xh(:) + if (present(origin_rh)) then + self%origin_rh(:) = origin_rh(:) end if if (present(origin_vh)) then self%origin_vh(:) = origin_vh(:) @@ -161,8 +161,8 @@ module subroutine util_set_particle_info(self, name, particle_type, status, orig if (present(discard_time)) then self%discard_time = discard_time end if - if (present(discard_xh)) then - self%discard_xh(:) = discard_xh(:) + if (present(discard_rh)) then + self%discard_rh(:) = discard_rh(:) end if if (present(discard_vh)) then self%discard_vh(:) = discard_vh(:) @@ -242,7 +242,7 @@ module subroutine util_set_rhill_approximate(self,cb) if (self%nbody == 0) return - rh(1:self%nbody) = .mag. self%xh(:,1:self%nbody) + 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 diff --git a/src/util/util_sort.f90 b/src/util/util_sort.f90 index dde5d7dfe..b1500afab 100644 --- a/src/util/util_sort.f90 +++ b/src/util/util_sort.f90 @@ -51,7 +51,7 @@ module subroutine util_sort_body(self, sortby, ascending) 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") + case("lfirst", "nbody", "ldiscard", "rh", "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!' @@ -760,7 +760,7 @@ module subroutine util_sort_rearrange_body(self, ind) 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%rh, 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) diff --git a/src/util/util_spill.f90 b/src/util/util_spill.f90 index 63d7fe1d9..9b9208252 100644 --- a/src/util/util_spill.f90 +++ b/src/util/util_spill.f90 @@ -339,7 +339,7 @@ module subroutine util_spill_body(self, discards, 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%rh, discards%rh, 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) diff --git a/src/whm/whm_coord.f90 b/src/whm/whm_coord.f90 index 2b888a279..4af8b56a9 100644 --- a/src/whm/whm_coord.f90 +++ b/src/whm/whm_coord.f90 @@ -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_gr.f90 b/src/whm/whm_gr.f90 index 02dc7d4a4..01bd6f285 100644 --- a/src/whm/whm_gr.f90 +++ b/src/whm/whm_gr.f90 @@ -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 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 @@ -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 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..d782c89f4 100644 --- a/src/whm/whm_kick.f90 +++ b/src/whm/whm_kick.f90 @@ -34,7 +34,7 @@ module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) associate(cb => 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 @@ -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 @@ -227,11 +227,11 @@ module subroutine whm_kick_vh_pl(self, system, param, t, dt, lbeg) call pl%accel(system, param, t, lbeg) pl%lfirst = .false. end if - call pl%set_beg_end(xbeg = pl%xh) + call pl%set_beg_end(xbeg = 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%set_beg_end(xend = pl%rh) end if do concurrent(i = 1:npl, pl%lmask(i)) pl%vh(:, i) = pl%vh(:, i) + pl%ah(:, i) * dt diff --git a/src/whm/whm_util.f90 b/src/whm/whm_util.f90 index 2143cf0e9..9c6efdd41 100644 --- a/src/whm/whm_util.f90 +++ b/src/whm/whm_util.f90 @@ -171,7 +171,7 @@ module subroutine whm_util_set_ir3j(self) if (self%nbody > 0) then do i = 1, self%nbody - r2 = dot_product(self%xh(:, i), self%xh(:, i)) + 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))